module HLRDB.Primitives.Aggregate
(
T(..)
, type (⟿)
, type Query
, aggregatePair
, remember
, runT
) where
import Data.Profunctor
import Data.Profunctor.Traversing
import Control.Lens hiding (Traversing)
import Data.ByteString
newtype T x y a b = T (Traversal a b x y) deriving (Functor)
instance Profunctor (T x y) where
dimap f g (T t) = T $ \m -> fmap g . t m . f
instance Traversing (T x y) where
traverse' (T t) = T (traverse . t)
instance Applicative (T x y a) where
pure x = T $ \_ _ -> pure x
(<*>) (T f) (T x) = T $ \g a -> f g a <*> x g a
aggregatePair :: T x y a b -> T x y c d -> T x y (a,c) (b,d)
aggregatePair (T f) (T g) = T $ \h (a,c) ->
(,) <$> f h a <*> g h c
remember :: T x y a b -> T x y a (a , b)
remember (T f) = T $ \x a -> (,) a <$> f x a
instance Strong (T x y) where
first' = firstTraversing
instance Choice (T x y) where
left' = leftTraversing
runT :: (Functor f) => ([x] -> f [y]) -> T x y a b -> a -> f b
runT i (T t) = unsafePartsOf t i
type (⟿) a b = T ByteString (Maybe ByteString) a b
type Query a b = a ⟿ b