diff options
Diffstat (limited to 'lib/ur/list.ur')
| -rw-r--r-- | lib/ur/list.ur | 33 |
1 files changed, 33 insertions, 0 deletions
diff --git a/lib/ur/list.ur b/lib/ur/list.ur index 3abd8b97..bca5f4ba 100644 --- a/lib/ur/list.ur +++ b/lib/ur/list.ur @@ -133,6 +133,20 @@ fun mapM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f = mapM' [] end +fun mapPartialM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f = + let + fun mapPartialM' acc ls = + case ls of + [] => return (rev acc) + | x :: ls => + v <- f x; + mapPartialM' (case v of + None => acc + | Some x' => x' :: acc) ls + in + mapPartialM' [] + end + fun mapXM [m ::: (Type -> Type)] (_ : monad m) [a] [ctx ::: {Unit}] f = let fun mapXM' ls = @@ -237,6 +251,25 @@ fun mapQuery [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type] []; return (rev ls) +fun mapQueryM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type] + [tables ~ exps] (q : sql_query tables exps) + (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction t) = + ls <- query q + (fn fs acc => v <- f fs; return (v :: acc)) + []; + return (rev ls) + +fun mapQueryPartialM [tables ::: {{Type}}] [exps ::: {Type}] [t ::: Type] + [tables ~ exps] (q : sql_query tables exps) + (f : $(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction (option t)) = + ls <- query q + (fn fs acc => v <- f fs; + return (case v of + None => acc + | Some v => v :: acc)) + []; + return (rev ls) + fun assoc [a] [b] (_ : eq a) (x : a) = let fun assoc' (ls : list (a * b)) = |