diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/ur/list.ur | 33 | ||||
| -rw-r--r-- | lib/ur/list.urs | 14 |
2 files changed, 47 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)) = diff --git a/lib/ur/list.urs b/lib/ur/list.urs index 5f3fad9c..c5e41816 100644 --- a/lib/ur/list.urs +++ b/lib/ur/list.urs @@ -27,6 +27,8 @@ val mapX : a ::: Type -> ctx ::: {Unit} -> (a -> xml ctx [] []) -> t a -> xml ct val mapM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type -> (a -> m b) -> t a -> m (t b) +val mapPartialM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type -> (a -> m (option b)) -> t a -> m (t b) + val mapXM : m ::: (Type -> Type) -> monad m -> a ::: Type -> ctx ::: {Unit} -> (a -> m (xml ctx [] [])) -> t a -> m (xml ctx [] []) @@ -53,6 +55,18 @@ val mapQuery : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type -> ($(exps ++ map (fn fields :: {Type} => $fields) tables) -> t) -> transaction (list t) +val mapQueryM : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type + -> [tables ~ exps] => + sql_query tables exps + -> ($(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction t) + -> transaction (list t) + +val mapQueryPartialM : tables ::: {{Type}} -> exps ::: {Type} -> t ::: Type + -> [tables ~ exps] => + sql_query tables exps + -> ($(exps ++ map (fn fields :: {Type} => $fields) tables) -> transaction (option t)) + -> transaction (list t) + (** Association lists *) val assoc : a ::: Type -> b ::: Type -> eq a -> a -> t (a * b) -> option b |