consumer_optional_library.tri (3583B)
1 -- Structural match on a computed search result retains request-local fallback. 2 !import "consumers.base-source" B 3 !import "consumers.structural" S 4 !import "consumers.lexical-worker" L 5 !import "prelude" !Local 6 !import "io" !Local 7 load path = do onOk_ 8 source <- readFile path 9 pure (matchResult (_ _ : err "consumer source did not parse" t) 10 (program _ : ok (snd program) t) (B.compileBaseSource source)) 11 base name = append "lib/consumer/" (append name ".scp") 12 worker program state = S.makeConsumer state (snd program) 13 compare reference lexical input = (equal? 14 (S.runConsumer reference input) (L.lRunChecked lexical input)) 15 firstOnly = snd (resultOr t (B.compileBaseSource 16 "consumer firstOnly\n leaf @ _ => stem leaf")) 17 checks finder nonempty prefix chooser = 18 let refPredicate = worker nonempty t in 19 let lexPredicate = resultOr t (L.lCompile refPredicate) in 20 let refFinder = worker finder refPredicate in 21 let lexFinder = resultOr t (L.lCompile (worker finder lexPredicate)) in 22 let refFirst = worker finder firstOnly in 23 let lexFirst = resultOr t (L.lCompile 24 (worker finder (resultOr t (L.lCompile firstOnly)))) in 25 let refPrefix = worker prefix "/api/" in 26 let lexPrefix = resultOr t (L.lCompile refPrefix) in 27 let refPath = worker chooser refPrefix in 28 let lexPath = resultOr t (L.lCompile (worker chooser lexPrefix)) in 29 let refSearch = worker chooser refFinder in 30 let lexSearch = resultOr t (L.lCompile (worker chooser lexFinder)) in 31 let refFirstSearch = worker chooser refFirst in 32 let lexFirstSearch = resultOr t (L.lCompile (worker chooser lexFirst)) in 33 let listInput = [[] [1 2] [3]] in 34 let request target fallback = pair target fallback in 35 foldl and? true [ 36 (resultIsOk (L.lCompile (worker chooser lexFinder))) 37 (compare refFinder lexFinder listInput) 38 (equal? (S.runConsumer refFinder listInput) (ok (t [1 2]) t)) 39 (compare refFinder lexFinder [[] []]) 40 (equal? (S.runConsumer refFinder [[] []]) (ok t t)) 41 (compare refFinder lexFinder []) 42 (compare refFirst lexFirst [t 7]) 43 (equal? (S.runConsumer refFirst [t 7]) (ok (t t) t)) 44 (compare refFirst lexFirst [7]) 45 (equal? (S.runConsumer refFirst [7]) (err "no matching consumer rule" t)) 46 (compare refSearch lexSearch (request listInput "not found")) 47 (equal? (S.runConsumer refSearch (request listInput "not found")) 48 (ok [1 2] t)) 49 (compare refSearch lexSearch (request [[] []] "not found")) 50 (equal? (S.runConsumer refSearch (request [[] []] "not found")) 51 (ok "not found" t)) 52 (compare refFirstSearch lexFirstSearch (request [t 7] "not found")) 53 (equal? (S.runConsumer refFirstSearch (request [t 7] "not found")) 54 (ok t t)) 55 (compare refPath lexPath (request "/api/item" "not found")) 56 (equal? (S.runConsumer refPath (request "/api/item" "not found")) 57 (ok "item" t)) 58 (compare refPath lexPath (request "/elsewhere" "not found")) 59 (equal? (S.runConsumer refPath (request "/elsewhere" "not found")) 60 (ok "not found" t)) 61 (compare refPath lexPath (request "/api/" "not found")) 62 (equal? (S.runConsumer refPath (request "/api/" "not found")) 63 (ok t t))] 64 stage = do onOk_ 65 finder <- load (base "find") 66 nonempty <- load (base "nonempty") 67 prefix <- load (base "stripPrefix") 68 chooser <- load "demos/consumers/collect-prefixes/choose-found.scp" 69 pure (ok (checks finder nonempty prefix chooser) t) 70 main = io (onResult_ stage 71 (_ : putStrLn "consumer-option-find-LOAD-FAIL") 72 (success : putStrLn (matchBool "consumer-option-find-ok" 73 "consumer-option-find-DIFFER" success))) 74 main