mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
node and shared tests now passing with new parser, also changed precedence of effect blocks to allow them to be used in operator expressions like foo <| do Remote { ... }
This commit is contained in:
parent
cea5e8c9d2
commit
059d8f14fd
@ -26,10 +26,10 @@ lambda :: Assertion
|
||||
lambda = testTermString "x -> x"
|
||||
|
||||
letBinding :: Assertion
|
||||
letBinding = testTermString "let x = 42; x + 1;;"
|
||||
letBinding = testTermString "let { x = 42; x + 1 }"
|
||||
|
||||
letRec :: Assertion
|
||||
letRec = testTermString "let rec x = x + 1; x;;"
|
||||
letRec = testTermString "let rec { x = x + 1; x }"
|
||||
|
||||
vec :: Assertion
|
||||
vec = testTermString "[\"a\", \"b\", \"c\"]"
|
||||
|
@ -61,7 +61,7 @@ unsafeRun p s s0 = case run p s s0 of
|
||||
Left e -> error e
|
||||
|
||||
string :: String -> Parser s String
|
||||
string = Parsec.string
|
||||
string s = attempt (Parsec.string s) <|> fail ("expected '" ++ s ++ "'")
|
||||
|
||||
takeLine :: String -> String
|
||||
takeLine = Prelude.takeWhile (/= '\n')
|
||||
|
@ -15,8 +15,8 @@ parser = L.spaced (P.attempt $ P.string "let") *> L.laidout (L.spaced (P.attempt
|
||||
type V = Symbol View.DFO
|
||||
type TermV = Term V
|
||||
|
||||
parse' :: P.Parser (PS.S V) a -> String -> Either String a
|
||||
parse' p input = P.run p input PS.s0
|
||||
-- parse' :: P.Parser (PS.S V) a -> String -> Either String a
|
||||
-- parse' p input = P.run p input PS.s0
|
||||
|
||||
-- parse :: P.Parser (PS.S V) TermV -> String -> Either String TermV
|
||||
-- parse p input = P.run p input PS.s0
|
||||
@ -24,20 +24,10 @@ parse' p input = P.run p input PS.s0
|
||||
parse :: P.Parser (PS.S V) [(V,TermV)] -> String -> Either String [(V, TermV)]
|
||||
parse p input = P.run p input PS.s0
|
||||
|
||||
input' = unlines
|
||||
[ "let "
|
||||
, " a = 23"
|
||||
, " x : Number"
|
||||
, " x = 2"
|
||||
, " x + 1" ]
|
||||
|
||||
-- input = "let { x = 1 ; x }"
|
||||
input = "(do Remote { pure 42 } )"
|
||||
-- input = "let\n x = 1\n x"
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
input <- readFile "unison-src/base.u"
|
||||
input <- readFile "unison-src/extra.u"
|
||||
-- let p = E.term
|
||||
let p = E.moduleBindings
|
||||
case parse p input of
|
||||
Left err -> putStrLn err
|
||||
|
@ -57,7 +57,7 @@ term :: Var v => Parser (S v) (Term v)
|
||||
term = term2
|
||||
|
||||
term2 :: Var v => Parser (S v) (Term v)
|
||||
term2 = lam term2 <|> effectBlock <|> term3
|
||||
term2 = lam term2 <|> term3
|
||||
|
||||
term3 :: Var v => Parser (S v) (Term v)
|
||||
term3 = do
|
||||
@ -74,14 +74,14 @@ infixApp = chainl1 term4 (f <$> infixVar)
|
||||
f op lhs rhs = Term.apps (Term.var op) [lhs,rhs]
|
||||
|
||||
term4 :: Var v => Parser (S v) (Term v)
|
||||
term4 = f <$> some term5
|
||||
term4 = effectBlock <|> term5
|
||||
|
||||
term5 :: Var v => Parser (S v) (Term v)
|
||||
term5 = f <$> some termLeaf
|
||||
where
|
||||
f (func:args) = Term.apps func args
|
||||
f [] = error "'some' shouldn't produce an empty list"
|
||||
|
||||
term5 :: Var v => Parser (S v) (Term v)
|
||||
term5 = termLeaf
|
||||
|
||||
termLeaf :: Var v => Parser (S v) (Term v)
|
||||
termLeaf =
|
||||
asum [hashLit, prefixTerm, lit, tupleOrParenthesized term, blank, vector term]
|
||||
@ -182,11 +182,10 @@ vector :: Ord v => Parser (S v) (Term v) -> Parser (S v) (Term v)
|
||||
vector p = Term.app (Term.builtin "Vector.force") . Term.vector <$> (lbracket *> elements <* rbracket)
|
||||
where
|
||||
lbracket = token (char '[')
|
||||
elements = sepBy comma p
|
||||
elements = sepBy comma (L.withoutLayout "vector element" p)
|
||||
comma = token (char ',')
|
||||
rbracket = token (char ']')
|
||||
|
||||
|
||||
let_ :: Var v => Parser (S v) (Term v)
|
||||
let_ = join $ fixup <$> (let_ *> optional rec_) <*> L.laidout (many alias *> bindingOrTerm)
|
||||
where
|
||||
@ -257,9 +256,8 @@ alias :: Var v => Parser (S v) ()
|
||||
alias = do
|
||||
_ <- token (string "alias")
|
||||
(fn:params) <- some (Var.named . Text.pack <$> wordyId keywords)
|
||||
_ <- token (string "=")
|
||||
body <- TypeParser.type_
|
||||
semicolon
|
||||
_ <- token (char '=')
|
||||
body <- L.block TypeParser.type_
|
||||
TypeParser.Aliases s <- get
|
||||
let s' = (fn, apply)
|
||||
apply args | length args <= length params = ABT.substs (params `zip` args) body
|
||||
|
@ -2,97 +2,87 @@
|
||||
-- to pick which nodes are responsible for which keys. See:
|
||||
-- https://en.wikipedia.org/wiki/Rendezvous_hashing
|
||||
|
||||
DIndex.Replication-Factor = 1;
|
||||
DIndex.Timeout = Duration.seconds 10;
|
||||
DIndex.Max-Timeout = Duration.seconds 500;
|
||||
DIndex.Replication-Factor = 1
|
||||
DIndex.Timeout = Duration.seconds 10
|
||||
DIndex.Max-Timeout = Duration.seconds 500
|
||||
|
||||
alias DIndex k v = Index Node (Index k v);
|
||||
alias DIndex k v = Index Node (Index k v)
|
||||
|
||||
DIndex.empty : ∀ k v . Remote (DIndex k v);
|
||||
DIndex.empty = Index.empty;
|
||||
DIndex.empty : ∀ k v . Remote (DIndex k v)
|
||||
DIndex.empty = Index.empty
|
||||
|
||||
-- Pick the nodes responsible for a key, using HRW hashing
|
||||
DIndex.nodesForKey : ∀ k v . k -> DIndex k v -> Remote (Vector Node);
|
||||
DIndex.nodesForKey : ∀ k v . k -> DIndex k v -> Remote (Vector Node)
|
||||
DIndex.nodesForKey k ind = do Remote
|
||||
nodes := Index.keys ind;
|
||||
hashes := Remote.traverse (node -> hash! (node, k)) nodes;
|
||||
nodes := Index.keys ind
|
||||
hashes := Remote.traverse (node -> hash! (node, k)) nodes
|
||||
(nodes `Vector.zip` hashes)
|
||||
|> Vector.sort-by Hash.Order 2nd
|
||||
|> Vector.take DIndex.Replication-Factor
|
||||
|> Vector.map 1st
|
||||
|> pure;;
|
||||
;
|
||||
|> Vector.sort-by Hash.Order 2nd
|
||||
|> Vector.take DIndex.Replication-Factor
|
||||
|> Vector.map 1st
|
||||
|> pure
|
||||
|
||||
DIndex.lookup : ∀ k v . k -> DIndex k v -> Remote (Optional v);
|
||||
DIndex.lookup : ∀ k v . k -> DIndex k v -> Remote (Optional v)
|
||||
DIndex.lookup k ind = do Remote
|
||||
nodes := DIndex.nodesForKey k ind;
|
||||
localLookup = node -> (do Remote
|
||||
nind := Index.lookup node ind;
|
||||
nodes := DIndex.nodesForKey k ind
|
||||
localLookup = node -> do Remote
|
||||
nind := Index.lookup node ind
|
||||
-- on slim chance that a Node is removed from the cluster just before
|
||||
-- we do the lookup, it gets treated like a timeout
|
||||
Optional.fold (Remote.map (const None) (Remote.sleep DIndex.Timeout))
|
||||
(Index.lookup k)
|
||||
nind;;)
|
||||
;
|
||||
nind
|
||||
-- todo: use Remote.quorum here
|
||||
Remote.race DIndex.Timeout <| Vector.map localLookup nodes;;
|
||||
;
|
||||
Remote.race DIndex.Timeout <| Vector.map localLookup nodes
|
||||
|
||||
DIndex.insert : ∀ k v . k -> v -> DIndex k v -> Remote Unit;
|
||||
DIndex.insert : ∀ k v . k -> v -> DIndex k v -> Remote Unit
|
||||
DIndex.insert k v ind = do Remote
|
||||
nodes := DIndex.nodesForKey k ind;
|
||||
localInsert = node -> (do Remote
|
||||
nind := Index.lookup node ind;
|
||||
nodes := DIndex.nodesForKey k ind
|
||||
localInsert = node -> do Remote
|
||||
nind := Index.lookup node ind
|
||||
Optional.fold (Remote.map (const Unit) (Remote.sleep DIndex.Timeout))
|
||||
(Index.insert k v)
|
||||
nind;;)
|
||||
;
|
||||
Remote.race DIndex.Timeout <| Vector.map localInsert nodes;;
|
||||
;
|
||||
nind
|
||||
Remote.race DIndex.Timeout <| Vector.map localInsert nodes
|
||||
|
||||
DIndex.join : ∀ k v . DIndex k v -> Remote Unit;
|
||||
DIndex.join : ∀ k v . DIndex k v -> Remote Unit
|
||||
DIndex.join ind = do Remote
|
||||
here := Remote.here;
|
||||
localInd := Index.empty;
|
||||
Index.insert here localInd ind;;
|
||||
;
|
||||
here := Remote.here
|
||||
localInd := Index.empty
|
||||
Index.insert here localInd ind
|
||||
|
||||
DIndex.indicesForKey : ∀ k v . k -> DIndex k v -> Remote (Vector (Index k v));
|
||||
DIndex.indicesForKey : ∀ k v . k -> DIndex k v -> Remote (Vector (Index k v))
|
||||
DIndex.indicesForKey k ind = do Remote
|
||||
nodes := DIndex.nodesForKey k ind;
|
||||
indices := Remote.traverse (node -> Index.lookup node ind) nodes;
|
||||
pure (Optional.somes indices);;
|
||||
;
|
||||
nodes := DIndex.nodesForKey k ind
|
||||
indices := Remote.traverse (node -> Index.lookup node ind) nodes
|
||||
pure (Optional.somes indices)
|
||||
|
||||
DIndex.rebalance : ∀ k v . k -> DIndex k v -> Remote Unit;
|
||||
DIndex.rebalance : ∀ k v . k -> DIndex k v -> Remote Unit
|
||||
DIndex.rebalance k ind = do Remote
|
||||
indices := DIndex.indicesForKey k ind;
|
||||
t = DIndex.Timeout;
|
||||
results := Remote.parallel-traverse DIndex.Max-Timeout (Index.lookup k `and-then` Remote.timeout t) indices;
|
||||
resultsHashes := Remote.traverse hash! results;
|
||||
uh := hash! None;
|
||||
hd = uh `Optional.get-or` Vector.at 0 resultsHashes;
|
||||
eq = h1 h2 -> Hash.erase h1 ==_Hash Hash.erase h2;
|
||||
indices := DIndex.indicesForKey k ind
|
||||
t = DIndex.Timeout
|
||||
results := Remote.parallel-traverse DIndex.Max-Timeout (Index.lookup k `and-then` Remote.timeout t) indices
|
||||
resultsHashes := Remote.traverse hash! results
|
||||
uh := hash! None
|
||||
hd = uh `Optional.get-or` Vector.at 0 resultsHashes
|
||||
eq = h1 h2 -> Hash.erase h1 ==_Hash Hash.erase h2
|
||||
if Vector.all? (eq hd) resultsHashes
|
||||
-- all results matched, we're good
|
||||
then pure Unit
|
||||
-- not all results matched, reinsert
|
||||
else (do Remote
|
||||
ov := DIndex.lookup k ind;
|
||||
else do Remote
|
||||
ov := DIndex.lookup k ind
|
||||
Optional.fold (pure Unit)
|
||||
(v -> DIndex.insert k v ind)
|
||||
ov;;)
|
||||
;;
|
||||
;
|
||||
ov
|
||||
|
||||
DIndex.leave : ∀ k v . Node -> DIndex k v -> Remote Unit;
|
||||
DIndex.leave : ∀ k v . Node -> DIndex k v -> Remote Unit
|
||||
DIndex.leave node ind = do Remote
|
||||
local-ind := Index.lookup node ind;
|
||||
Index.delete node ind;
|
||||
local-ind := Index.lookup node ind
|
||||
Index.delete node ind
|
||||
Optional.fold
|
||||
(pure Unit)
|
||||
(local-ind -> do Remote
|
||||
(local-ind -> do Remote {
|
||||
keys := Index.keys local-ind;
|
||||
Remote.fork <| Remote.traverse (k -> DIndex.rebalance k ind) keys;;)
|
||||
local-ind;;
|
||||
;
|
||||
Remote.fork <| Remote.traverse (k -> DIndex.rebalance k ind) keys })
|
||||
local-ind
|
||||
|
@ -1,84 +1,83 @@
|
||||
|
||||
Index.empty : ∀ k v . Remote (Index k v);
|
||||
Index.empty = Remote.map Index.empty# Remote.here;
|
||||
Index.empty : ∀ k v . Remote (Index k v)
|
||||
Index.empty = Remote.map Index.empty# Remote.here
|
||||
|
||||
Index.keys : ∀ k v . Index k v -> Remote (Vector k);
|
||||
Index.keys = Index.from-unsafe Index.keys#;
|
||||
Index.keys : ∀ k v . Index k v -> Remote (Vector k)
|
||||
Index.keys = Index.from-unsafe Index.keys#
|
||||
|
||||
Index.1st-key : ∀ k v . Index k v -> Remote (Optional k);
|
||||
Index.1st-key = Index.from-unsafe Index.1st-key#;
|
||||
Index.1st-key : ∀ k v . Index k v -> Remote (Optional k)
|
||||
Index.1st-key = Index.from-unsafe Index.1st-key#
|
||||
|
||||
Index.increment : ∀ k v . k -> Index k v -> Remote (Optional k);
|
||||
Index.increment k = Index.from-unsafe (Index.increment# k);
|
||||
Index.increment : ∀ k v . k -> Index k v -> Remote (Optional k)
|
||||
Index.increment k = Index.from-unsafe (Index.increment# k)
|
||||
|
||||
Index.lookup : ∀ k v . k -> Index k v -> Remote (Optional v);
|
||||
Index.lookup k = Index.from-unsafe (Index.lookup# k);
|
||||
Index.lookup : ∀ k v . k -> Index k v -> Remote (Optional v)
|
||||
Index.lookup k = Index.from-unsafe (Index.lookup# k)
|
||||
|
||||
Index.lookup-or : ∀ k v . v -> k -> Index k v -> Remote v;
|
||||
Index.lookup-or : ∀ k v . v -> k -> Index k v -> Remote v
|
||||
Index.lookup-or v k ind =
|
||||
Remote.map (Optional.get-or v) (Index.lookup k ind);
|
||||
Remote.map (Optional.get-or v) (Index.lookup k ind)
|
||||
|
||||
Index.delete : ∀ k v . k -> Index k v -> Remote Unit;
|
||||
Index.delete k = Index.from-unsafe (Index.delete# k);
|
||||
Index.delete : ∀ k v . k -> Index k v -> Remote Unit
|
||||
Index.delete k = Index.from-unsafe (Index.delete# k)
|
||||
|
||||
Index.insert : ∀ k v . k -> v -> Index k v -> Remote Unit;
|
||||
Index.insert k v = Index.from-unsafe (Index.insert# k v);
|
||||
Index.insert : ∀ k v . k -> v -> Index k v -> Remote Unit
|
||||
Index.insert k v = Index.from-unsafe (Index.insert# k v)
|
||||
|
||||
Index.inserts : ∀ k v . Vector (k,v) -> Index k v -> Remote Unit;
|
||||
Index.inserts : ∀ k v . Vector (k,v) -> Index k v -> Remote Unit
|
||||
Index.inserts vs ind = Remote.map (const Unit) <|
|
||||
Remote.traverse (kv -> Index.insert (1st kv) (2nd kv) ind) vs;
|
||||
Remote.traverse (kv -> Index.insert (1st kv) (2nd kv) ind) vs
|
||||
|
||||
Index.from-unsafe : ∀ k v r . (Text -> r) -> Index k v -> Remote r;
|
||||
Index.from-unsafe : ∀ k v r . (Text -> r) -> Index k v -> Remote r
|
||||
Index.from-unsafe f ind = let
|
||||
p = Index.representation# ind;
|
||||
Remote.map f (Remote.at (1st p) (2nd p));;
|
||||
;
|
||||
p = Index.representation# ind
|
||||
Remote.map f (Remote.at (1st p) (2nd p))
|
||||
|
||||
|
||||
alias IndexedTraversal k v =
|
||||
( Remote (Optional k) -- first key
|
||||
, k -> Remote (Optional v) -- lookup the value for a key
|
||||
, k -> Remote (Optional k)); -- increment a key
|
||||
, k -> Remote (Optional k)) -- increment a key
|
||||
|
||||
IndexedTraversal.1st-key : ∀ k v . IndexedTraversal k v -> Remote (Optional k);
|
||||
IndexedTraversal.1st-key t = 1st t;
|
||||
IndexedTraversal.1st-key : ∀ k v . IndexedTraversal k v -> Remote (Optional k)
|
||||
IndexedTraversal.1st-key t = 1st t
|
||||
|
||||
IndexedTraversal.lookup : ∀ k v . k -> IndexedTraversal k v -> Remote (Optional v);
|
||||
IndexedTraversal.lookup k t = 2nd t k;
|
||||
IndexedTraversal.lookup : ∀ k v . k -> IndexedTraversal k v -> Remote (Optional v)
|
||||
IndexedTraversal.lookup k t = 2nd t k
|
||||
|
||||
-- | Returns the smallest key in the traversal which is > the provided key.
|
||||
IndexedTraversal.increment : ∀ k v . k -> IndexedTraversal k v -> Remote (Optional k);
|
||||
IndexedTraversal.increment k t = 3rd t k;
|
||||
IndexedTraversal.increment : ∀ k v . k -> IndexedTraversal k v -> Remote (Optional k)
|
||||
IndexedTraversal.increment k t = 3rd t k
|
||||
|
||||
-- | Returns the smallest key in the traversal which is >= the provided key.
|
||||
IndexedTraversal.ceiling : ∀ k v . k -> IndexedTraversal k v -> Remote (Optional k);
|
||||
IndexedTraversal.ceiling : ∀ k v . k -> IndexedTraversal k v -> Remote (Optional k)
|
||||
IndexedTraversal.ceiling k t =
|
||||
IndexedTraversal.lookup k t |> Remote.bind (
|
||||
Optional.fold (IndexedTraversal.increment k t) (const (pure <| Some k))
|
||||
);
|
||||
)
|
||||
|
||||
-- | Returns the smallest key existing in both traversals which is >= the provided key
|
||||
IndexedTraversal.ceiling-both : ∀ k v . k -> IndexedTraversal k v -> IndexedTraversal k v -> Remote (Optional k);
|
||||
IndexedTraversal.ceiling-both : ∀ k v . k -> IndexedTraversal k v -> IndexedTraversal k v -> Remote (Optional k)
|
||||
IndexedTraversal.ceiling-both k t1 t2 =
|
||||
IndexedTraversal.ceiling k t1 |>
|
||||
Remote.bind (Optional.fold (Remote.pure None) (k -> IndexedTraversal.ceiling k t2));
|
||||
Remote.bind (Optional.fold (Remote.pure None) (k -> IndexedTraversal.ceiling k t2))
|
||||
|
||||
Index.traversal : ∀ k v . Index k v -> IndexedTraversal (k, Hash k) v;
|
||||
Index.traversal : ∀ k v . Index k v -> IndexedTraversal (k, Hash k) v
|
||||
Index.traversal ind = let
|
||||
add-hash = Optional.map (k -> (k, hash# k));
|
||||
add-hash = Optional.map (k -> (k, hash# k))
|
||||
( Index.1st-key ind |> Remote.map add-hash
|
||||
, k -> Index.lookup (1st k) ind
|
||||
, k -> Index.increment (1st k) ind |> Remote.map add-hash
|
||||
);;
|
||||
;
|
||||
)
|
||||
|
||||
IndexedTraversal.empty : ∀ k v . IndexedTraversal k v;
|
||||
IndexedTraversal.empty : ∀ k v . IndexedTraversal k v
|
||||
IndexedTraversal.empty =
|
||||
(Remote.pure None, const (Remote.pure None), const (Remote.pure None));
|
||||
(Remote.pure None, const (Remote.pure None), const (Remote.pure None))
|
||||
|
||||
IndexedTraversal.intersect : ∀ k v . Order k
|
||||
-> IndexedTraversal k v
|
||||
-> IndexedTraversal k v
|
||||
-> IndexedTraversal k v;
|
||||
-> IndexedTraversal k v
|
||||
IndexedTraversal.intersect o t1 t2 = let rec
|
||||
align-key k1 k2 = Optional.get-or (Remote.pure None) <| Optional.map2
|
||||
(k1 k2 -> Order.compare o k1 k2 |> Comparison.fold
|
||||
@ -90,39 +89,38 @@ IndexedTraversal.intersect o t1 t2 = let rec
|
||||
(IndexedTraversal.ceiling k1 t2 |> Remote.bind (k2 -> align-key (Some k1) k2))
|
||||
)
|
||||
k1 k2
|
||||
;
|
||||
1st-key = Remote.map2' align-key (1st t1) (1st t2);
|
||||
lookup k = 2nd t1 k |> Remote.bind (Optional.fold (Remote.pure None) (a -> 2nd t2 k));
|
||||
increment k = Remote.map2' align-key (3rd t1 k) (3rd t2 k);
|
||||
(1st-key, lookup, increment);;
|
||||
;
|
||||
|
||||
IndexedTraversal.1st-entry : ∀ k v . IndexedTraversal k v -> Remote (Optional (k, v));
|
||||
IndexedTraversal.1st-entry t = IndexedTraversal.entry-at (1st t) t;
|
||||
1st-key = Remote.map2' align-key (1st t1) (1st t2)
|
||||
lookup k = 2nd t1 k |> Remote.bind (Optional.fold (Remote.pure None) (a -> 2nd t2 k))
|
||||
increment k = Remote.map2' align-key (3rd t1 k) (3rd t2 k)
|
||||
(1st-key, lookup, increment)
|
||||
|
||||
|
||||
IndexedTraversal.1st-entry : ∀ k v . IndexedTraversal k v -> Remote (Optional (k, v))
|
||||
IndexedTraversal.1st-entry t = IndexedTraversal.entry-at (1st t) t
|
||||
|
||||
IndexedTraversal.entry-at : ∀ k v .
|
||||
Remote (Optional k) -> IndexedTraversal k v -> Remote (Optional (k, v));
|
||||
Remote (Optional k) -> IndexedTraversal k v -> Remote (Optional (k, v))
|
||||
IndexedTraversal.entry-at k t = do Remote
|
||||
k := k;
|
||||
v := Optional.fold (pure None) (2nd t) k;
|
||||
pure (Optional.map2 (k v -> (k,v)) k v);;
|
||||
;
|
||||
k := k
|
||||
v := Optional.fold (pure None) (2nd t) k
|
||||
pure (Optional.map2 (k v -> (k,v)) k v)
|
||||
|
||||
IndexedTraversal.take : ∀ k v . Number -> IndexedTraversal k v -> Remote (Vector (k,v));
|
||||
IndexedTraversal.take : ∀ k v . Number -> IndexedTraversal k v -> Remote (Vector (k,v))
|
||||
IndexedTraversal.take n t =
|
||||
Remote.unfold (t, n) (tn -> let
|
||||
Remote.unfold (t, n) (tn -> let {
|
||||
t = 1st tn;
|
||||
n = 2nd tn;
|
||||
step e = (e, (set-1st (IndexedTraversal.increment (1st e) t) t, n - 1));
|
||||
if n <=_Number 0 then Remote.pure None
|
||||
else IndexedTraversal.1st-entry t |> Remote.map (Optional.map step);;
|
||||
);
|
||||
else IndexedTraversal.1st-entry t |> Remote.map (Optional.map step)
|
||||
})
|
||||
|
||||
IndexedTraversal.take-keys : ∀ k v . Number -> IndexedTraversal k v -> Remote (Vector k);
|
||||
IndexedTraversal.take-keys n t = IndexedTraversal.take n t |> Remote.map (Vector.map 1st);
|
||||
IndexedTraversal.take-keys : ∀ k v . Number -> IndexedTraversal k v -> Remote (Vector k)
|
||||
IndexedTraversal.take-keys n t = IndexedTraversal.take n t |> Remote.map (Vector.map 1st)
|
||||
|
||||
Http.get-url : Text -> Remote (Either Text Text);
|
||||
Http.get-url url = Remote.map Http.get-url# (Remote.pure url);
|
||||
Http.get-url : Text -> Remote (Either Text Text)
|
||||
Http.get-url url = Remote.map Http.get-url# (Remote.pure url)
|
||||
|
||||
hash! : ∀ a . a -> Remote (Hash a);
|
||||
hash! a = Remote.map hash# (Remote.pure a);
|
||||
hash! : ∀ a . a -> Remote (Hash a)
|
||||
hash! a = Remote.map hash# (Remote.pure a)
|
||||
|
@ -1,76 +1,73 @@
|
||||
let
|
||||
alias DIndex k v = Index Node (Index k v);
|
||||
alias Set v = Index v Unit;
|
||||
alias DIndex k v = Index Node (Index k v)
|
||||
alias Set v = Index v Unit
|
||||
|
||||
-- Maps keywords to set of page content hashes with that keyword
|
||||
alias SearchIndex = DIndex Text (Set (Hash Text));
|
||||
alias SearchIndex = DIndex Text (Set (Hash Text))
|
||||
|
||||
-- Maps page hash to canonical Url for that hash
|
||||
alias CanonicalUrls = DIndex (Hash Text) Text;
|
||||
alias CanonicalUrls = DIndex (Hash Text) Text
|
||||
|
||||
-- Maps page hash to a short, plain text exerpt from that page
|
||||
alias Excerpts = DIndex (Hash Text) Text;
|
||||
alias Excerpts = DIndex (Hash Text) Text
|
||||
|
||||
-- Using the search index, returns the list of page hashes (up to limit)
|
||||
-- whose content contains all the keywords of the query
|
||||
search : Number -> Vector Text -> SearchIndex
|
||||
-> Remote (Vector (Hash Text));
|
||||
-> Remote (Vector (Hash Text))
|
||||
search limit query ind = do Remote
|
||||
url-sets := Remote.traverse (k -> DIndex.lookup k ind) query;
|
||||
url-sets = Vector.map Index.traversal (Optional.somes url-sets);
|
||||
merge = IndexedTraversal.intersect (Order.by-2nd Hash.Order);
|
||||
urls = Optional.get-or IndexedTraversal.empty <| Vector.fold-balanced1 merge url-sets;
|
||||
urls := IndexedTraversal.take-keys limit urls;
|
||||
pure (Vector.map 1st urls);;
|
||||
;
|
||||
url-sets := Remote.traverse (k -> DIndex.lookup k ind) query
|
||||
url-sets = Vector.map Index.traversal (Optional.somes url-sets)
|
||||
merge = IndexedTraversal.intersect (Order.by-2nd Hash.Order)
|
||||
urls = Optional.get-or IndexedTraversal.empty <| Vector.fold-balanced1 merge url-sets
|
||||
urls := IndexedTraversal.take-keys limit urls
|
||||
pure (Vector.map 1st urls)
|
||||
|
||||
-- Plain-text formating of a set of results
|
||||
format-results : Vector (Hash Text) -> CanonicalUrls -> Excerpts -> Remote Text;
|
||||
format-results : Vector (Hash Text) -> CanonicalUrls -> Excerpts -> Remote Text
|
||||
format-results hs urls excerpts = do Remote
|
||||
urls := Remote.map Optional.somes <| Remote.traverse (h -> DIndex.lookup h urls) hs;
|
||||
excerpts := Remote.map Optional.somes <| Remote.traverse (h -> DIndex.lookup h excerpts) hs;
|
||||
fmt = p -> Text.join [1st p, Text.newline, 2nd p, Text.newline, "***", Text.newline];
|
||||
pure <| Text.join (Vector.map fmt (urls `Vector.zip` excerpts));;
|
||||
;
|
||||
urls := Remote.map Optional.somes <| Remote.traverse (h -> DIndex.lookup h urls) hs
|
||||
excerpts := Remote.map Optional.somes <| Remote.traverse (h -> DIndex.lookup h excerpts) hs
|
||||
fmt = p -> Text.join [1st p, Text.newline, 2nd p, Text.newline, "***", Text.newline]
|
||||
pure <| Text.join (Vector.map fmt (urls `Vector.zip` excerpts))
|
||||
|
||||
trim-to-host : Text -> Text;
|
||||
trim-to-host : Text -> Text
|
||||
trim-to-host url = Optional.get-or url <| do Optional
|
||||
host := Uri.parse-authority url;
|
||||
scheme := Uri.parse-scheme url;
|
||||
pure (Text.concatenate scheme ("//" `Text.concatenate` host));;
|
||||
;
|
||||
host := Uri.parse-authority url
|
||||
scheme := Uri.parse-scheme url
|
||||
pure (Text.concatenate scheme ("//" `Text.concatenate` host))
|
||||
|
||||
-- | Convert url (possibly relative to parent) to an absolute url
|
||||
resolve-url : Text -> Text -> Text;
|
||||
resolve-url : Text -> Text -> Text
|
||||
resolve-url parent child =
|
||||
if Text.take 1 child ==_Text "/" then
|
||||
Text.concatenate (trim-to-host parent) child
|
||||
else if (Text.take 5 child ==_Text "http:") `or` (Text.take 6 child ==_Text "https:") then
|
||||
child
|
||||
else Text.join [parent, if Text.ends-with "/" parent then "" else "/", child]
|
||||
;
|
||||
|
||||
crawl : Number -> SearchIndex -> CanonicalUrls -> Excerpts -> Text -> Remote Unit;
|
||||
crawl : Number -> SearchIndex -> CanonicalUrls -> Excerpts -> Text -> Remote Unit
|
||||
crawl depth ind visited excerpts url = let rec
|
||||
insert url keyword = do Remote
|
||||
url-set := DIndex.lookup keyword ind;
|
||||
url-set := DIndex.lookup keyword ind
|
||||
Optional.fold
|
||||
(do Remote
|
||||
(do Remote {
|
||||
url-set := Index.empty;
|
||||
DIndex.insert keyword url-set ind;
|
||||
insert url keyword;;)
|
||||
insert url keyword
|
||||
})
|
||||
(Index.insert url Unit)
|
||||
url-set;;
|
||||
;
|
||||
url-set
|
||||
|
||||
go depth url =
|
||||
if depth <=_Number 0 then Remote.pure Unit
|
||||
else do Remote
|
||||
page := Remote.map (Debug.log "indexing url" url) (Http.get-url url);
|
||||
page = Either.fold (err -> Debug.log "error fetching" (url, err) "") identity page;
|
||||
page-hash := hash! page;
|
||||
h := DIndex.lookup page-hash visited;
|
||||
page := Remote.map (Debug.log "indexing url" url) (Http.get-url url)
|
||||
page = Either.fold (err -> Debug.log "error fetching" (url, err) "") identity page
|
||||
page-hash := hash! page
|
||||
h := DIndex.lookup page-hash visited
|
||||
Optional.fold
|
||||
(do Remote
|
||||
(do Remote {
|
||||
page-text = Html.plain-text page;
|
||||
keywords = Text.words page-text
|
||||
|> Vector.map Text.lowercase
|
||||
@ -88,39 +85,37 @@ let
|
||||
Debug.log "finished indexing" url <| DIndex.insert page-hash url visited;
|
||||
-- recurse
|
||||
Remote.traverse (go (depth - 1)) links;
|
||||
pure Unit;;)
|
||||
pure Unit
|
||||
})
|
||||
(x -> Remote.pure (Debug.log "already visited" url Unit))
|
||||
h;;
|
||||
;
|
||||
go depth url;;
|
||||
;
|
||||
h
|
||||
go depth url
|
||||
|
||||
do Remote
|
||||
n := Remote.spawn;
|
||||
Remote.transfer n;
|
||||
n := Remote.spawn
|
||||
Remote.transfer n
|
||||
|
||||
-- Build DIndex for index state and for crawler state
|
||||
ind := DIndex.empty;
|
||||
visited := DIndex.empty;
|
||||
excerpts := DIndex.empty;
|
||||
ind-nodes := Remote.replicate 3 Remote.spawn;
|
||||
visited-nodes := Remote.replicate 3 Remote.spawn;
|
||||
excerpts-nodes := Remote.replicate 3 Remote.spawn;
|
||||
Remote.traverse (n -> Remote.at' n (DIndex.join ind)) ind-nodes;
|
||||
Remote.traverse (n -> Remote.at' n (DIndex.join visited)) visited-nodes;
|
||||
Remote.traverse (n -> Remote.at' n (DIndex.join excerpts)) excerpts-nodes;
|
||||
ind := DIndex.empty
|
||||
visited := DIndex.empty
|
||||
excerpts := DIndex.empty
|
||||
ind-nodes := Remote.replicate 3 Remote.spawn
|
||||
visited-nodes := Remote.replicate 3 Remote.spawn
|
||||
excerpts-nodes := Remote.replicate 3 Remote.spawn
|
||||
Remote.traverse (n -> Remote.at' n (DIndex.join ind)) ind-nodes
|
||||
Remote.traverse (n -> Remote.at' n (DIndex.join visited)) visited-nodes
|
||||
Remote.traverse (n -> Remote.at' n (DIndex.join excerpts)) excerpts-nodes
|
||||
|
||||
-- Kick off multiple crawlers
|
||||
Remote.fork <| crawl 5 ind visited excerpts "http://unisonweb.org/design";
|
||||
Remote.fork <| crawl 5 ind visited excerpts "http://www.cnn.com";
|
||||
Remote.fork <| crawl 5 ind visited excerpts "http://lambda-the-ultimate.org/";
|
||||
Remote.fork <| crawl 5 ind visited excerpts "http://unisonweb.org/design"
|
||||
Remote.fork <| crawl 5 ind visited excerpts "http://www.cnn.com"
|
||||
Remote.fork <| crawl 5 ind visited excerpts "http://lambda-the-ultimate.org/"
|
||||
|
||||
-- Wait a while for crawlers to index a bunch of pages, then do query
|
||||
u = Debug.watch "waiting 2 minutes for indexing before issuing queries..." Unit;
|
||||
Remote.sleep (Duration.seconds 120);
|
||||
u = Debug.watch "done waiting for indexing, getting results" Unit;
|
||||
results := search 10 ["design", "unison", "programming"] ind;
|
||||
results := format-results results visited excerpts;
|
||||
pure <| Debug.log results Unit results;;
|
||||
-- pure <| Debug.watch "results" results;;
|
||||
;;
|
||||
u = Debug.watch "waiting 2 minutes for indexing before issuing queries..." Unit
|
||||
Remote.sleep (Duration.seconds 120)
|
||||
u = Debug.watch "done waiting for indexing, getting results" Unit
|
||||
results := search 10 ["design", "unison", "programming"] ind
|
||||
results := format-results results visited excerpts
|
||||
pure <| Debug.log results Unit results
|
||||
-- pure <| Debug.watch "results" results
|
||||
|
Loading…
Reference in New Issue
Block a user