{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}
module Data.Greskell.Extra
(
lookupAs,
lookupAs',
lookupListAs,
lookupListAs',
pMapToFail,
writeKeyValues,
(<=:>),
(<=?>),
writePropertyKeyValues,
writePMapProperties,
gWhenEmptyInput
) where
import Data.Aeson (ToJSON)
import Control.Category ((<<<))
import Data.Foldable (Foldable)
import Data.Greskell.Binder (Binder, newBind)
import Data.Greskell.Graph
( Property(..), Element, KeyValue(..), (=:), Key
)
import qualified Data.Greskell.Graph as Graph
import Data.Greskell.GTraversal
( Walk, WalkType, SideEffect, Transform,
ToGTraversal(..), Split, Lift, liftWalk,
gProperty, gCoalesce, gUnfold, gFold
)
import Data.Greskell.PMap
( PMap, pMapToList,
lookupAs,
lookupAs',
lookupListAs,
lookupListAs',
pMapToFail
)
import Data.Monoid (mconcat)
import Data.Text (Text)
writePropertyKeyValues :: (ToJSON v, Element e) => [(Text, v)] -> Binder (Walk SideEffect e e)
writePropertyKeyValues :: [(Text, v)] -> Binder (Walk SideEffect e e)
writePropertyKeyValues [(Text, v)]
pairs = ([KeyValue e] -> Walk SideEffect e e)
-> Binder [KeyValue e] -> Binder (Walk SideEffect e e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [KeyValue e] -> Walk SideEffect e e
forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues (Binder [KeyValue e] -> Binder (Walk SideEffect e e))
-> Binder [KeyValue e] -> Binder (Walk SideEffect e e)
forall a b. (a -> b) -> a -> b
$ ((Text, v) -> Binder (KeyValue e))
-> [(Text, v)] -> Binder [KeyValue e]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, v) -> Binder (KeyValue e)
forall b a. ToJSON b => (Text, b) -> Binder (KeyValue a)
toKeyValue [(Text, v)]
pairs
where
toKeyValue :: (Text, b) -> Binder (KeyValue a)
toKeyValue (Text
key, b
value) = Text -> Key a b
forall a b. Text -> Key a b
Graph.key Text
key Key a b -> b -> Binder (KeyValue a)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> b
value
writeKeyValues :: Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues :: [KeyValue e] -> Walk SideEffect e e
writeKeyValues [KeyValue e]
pairs = [Walk SideEffect e e] -> Walk SideEffect e e
forall a. Monoid a => [a] -> a
mconcat ([Walk SideEffect e e] -> Walk SideEffect e e)
-> [Walk SideEffect e e] -> Walk SideEffect e e
forall a b. (a -> b) -> a -> b
$ KeyValue e -> [Walk SideEffect e e]
forall a. Element a => KeyValue a -> [Walk SideEffect a a]
toPropStep (KeyValue e -> [Walk SideEffect e e])
-> [KeyValue e] -> [Walk SideEffect e e]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [KeyValue e]
pairs
where
toPropStep :: KeyValue a -> [Walk SideEffect a a]
toPropStep (KeyValue Key a b
k Greskell b
v) = [Key a b -> Greskell b -> Walk SideEffect a a
forall e v.
Element e =>
Key e v -> Greskell v -> Walk SideEffect e e
gProperty Key a b
k Greskell b
v]
toPropStep (KeyNoValue Key a b
_) = []
writePMapProperties :: (Foldable c, ToJSON v, Element e)
=> PMap c v -> Binder (Walk SideEffect e e)
writePMapProperties :: PMap c v -> Binder (Walk SideEffect e e)
writePMapProperties = [(Text, v)] -> Binder (Walk SideEffect e e)
forall v e.
(ToJSON v, Element e) =>
[(Text, v)] -> Binder (Walk SideEffect e e)
writePropertyKeyValues ([(Text, v)] -> Binder (Walk SideEffect e e))
-> (PMap c v -> [(Text, v)])
-> PMap c v
-> Binder (Walk SideEffect e e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PMap c v -> [(Text, v)]
forall (c :: * -> *) v. Foldable c => PMap c v -> [(Text, v)]
pMapToList
(<=:>) :: ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> :: Key a b -> b -> Binder (KeyValue a)
(<=:>) Key a b
k b
v = Key a b -> Greskell b -> KeyValue a
forall a b. Key a b -> Greskell b -> KeyValue a
(=:) Key a b
k (Greskell b -> KeyValue a)
-> Binder (Greskell b) -> Binder (KeyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> Binder (Greskell b)
forall v. ToJSON v => v -> Binder (Greskell v)
newBind b
v
(<=?>) :: ToJSON b => Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
<=?> :: Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
(<=?>) Key a (Maybe b)
k v :: Maybe b
v@(Just b
_) = Key a (Maybe b)
k Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> Maybe b
v
(<=?>) Key a (Maybe b)
k Maybe b
Nothing = KeyValue a -> Binder (KeyValue a)
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyValue a -> Binder (KeyValue a))
-> KeyValue a -> Binder (KeyValue a)
forall a b. (a -> b) -> a -> b
$ Key a (Maybe b) -> KeyValue a
forall a b. Key a b -> KeyValue a
KeyNoValue Key a (Maybe b)
k
gWhenEmptyInput :: (ToGTraversal g, Split cc c, Lift Transform cc, Lift Transform c, WalkType c, WalkType cc)
=> g cc [s] s
-> Walk c s s
gWhenEmptyInput :: g cc [s] s -> Walk c s s
gWhenEmptyInput g cc [s] s
body = [GTraversal cc [s] s] -> Walk c [s] s
forall (g :: * -> * -> * -> *) cc c s e.
(ToGTraversal g, Split cc c, Lift Transform c, WalkType c,
WalkType cc) =>
[g cc s e] -> Walk c s e
gCoalesce
[ GTraversal Transform [s] s -> GTraversal cc [s] s
forall (g :: * -> * -> * -> *) from to s e.
(ToGTraversal g, WalkType from, WalkType to, Lift from to) =>
g from s e -> g to s e
liftWalk (GTraversal Transform [s] s -> GTraversal cc [s] s)
-> GTraversal Transform [s] s -> GTraversal cc [s] s
forall a b. (a -> b) -> a -> b
$ Walk Transform [s] s -> GTraversal Transform [s] s
forall (g :: * -> * -> * -> *) c s e.
(ToGTraversal g, WalkType c) =>
g c s e -> GTraversal c s e
toGTraversal Walk Transform [s] s
forall a. AsIterator a => Walk Transform a (IteratorItem a)
gUnfold,
g cc [s] s -> GTraversal cc [s] s
forall (g :: * -> * -> * -> *) c s e.
(ToGTraversal g, WalkType c) =>
g c s e -> GTraversal c s e
toGTraversal g cc [s] s
body
] Walk c [s] s -> Walk c s [s] -> Walk c s s
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Walk Transform s [s] -> Walk c s [s]
forall (g :: * -> * -> * -> *) from to s e.
(ToGTraversal g, WalkType from, WalkType to, Lift from to) =>
g from s e -> g to s e
liftWalk Walk Transform s [s]
forall a. Walk Transform a [a]
gFold