unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-09-11 02:25:39 +03:00
Code Issues Projects Releases Wiki Activity

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 { ... }

Browse Source
This commit is contained in:
Paul Chiusano 2016-12-13 12:07:43 -05:00
parent cea5e8c9d2
commit 059d8f14fd
7 changed files with 185 additions and 214 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
node/tests/Unison/Test/SerializationAndHashing.hs
View File

@ -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\"]"

2
shared/src/Unison/Parser.hs
View File

@ -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')

18
shared/src/Unison/Scratch.hs
View File

@ -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

18
shared/src/Unison/TermParser.hs
View File

@ -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

110
unison-src/dindex.u
View File

@ -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

124
unison-src/extra.u
View File

@ -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)

123
unison-src/searchengine.u
View File

@ -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