{-# LANGUAGE FlexibleInstances #-} module Argo.Codec.Codec where import Control.Applicative ((<|>)) import qualified Control.Applicative as Applicative data Codec r w s i o = Codec { Codec r w s i o -> r o decode :: r o , Codec r w s i o -> i -> w o encode :: i -> w o , Codec r w s i o -> s schema :: s } instance (Functor r, Functor w) => Functor (Codec r w s i) where fmap :: (a -> b) -> Codec r w s i a -> Codec r w s i b fmap a -> b f Codec r w s i a c = Codec :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec { decode :: r b decode = a -> b f (a -> b) -> r a -> r b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Codec r w s i a -> r a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o decode Codec r w s i a c , encode :: i -> w b encode = (a -> b) -> w a -> w b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f (w a -> w b) -> (i -> w a) -> i -> w b forall b c a. (b -> c) -> (a -> b) -> a -> c . Codec r w s i a -> i -> w a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o encode Codec r w s i a c , schema :: s schema = Codec r w s i a -> s forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s schema Codec r w s i a c } instance ( Applicative r , Applicative w , Applicative s , Monoid a ) => Applicative (Codec r w (s a) i) where pure :: a -> Codec r w (s a) i a pure a x = Codec :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec { decode :: r a decode = a -> r a forall (f :: * -> *) a. Applicative f => a -> f a pure a x , encode :: i -> w a encode = w a -> i -> w a forall a b. a -> b -> a const (w a -> i -> w a) -> w a -> i -> w a forall a b. (a -> b) -> a -> b $ a -> w a forall (f :: * -> *) a. Applicative f => a -> f a pure a x , schema :: s a schema = a -> s a forall (f :: * -> *) a. Applicative f => a -> f a pure a forall a. Monoid a => a mempty } Codec r w (s a) i (a -> b) cf <*> :: Codec r w (s a) i (a -> b) -> Codec r w (s a) i a -> Codec r w (s a) i b <*> Codec r w (s a) i a cx = Codec :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec { decode :: r b decode = Codec r w (s a) i (a -> b) -> r (a -> b) forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o decode Codec r w (s a) i (a -> b) cf r (a -> b) -> r a -> r b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Codec r w (s a) i a -> r a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o decode Codec r w (s a) i a cx , encode :: i -> w b encode = \i i -> Codec r w (s a) i (a -> b) -> i -> w (a -> b) forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o encode Codec r w (s a) i (a -> b) cf i i w (a -> b) -> w a -> w b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Codec r w (s a) i a -> i -> w a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o encode Codec r w (s a) i a cx i i , schema :: s a schema = a -> a -> a forall a. Semigroup a => a -> a -> a (<>) (a -> a -> a) -> s a -> s (a -> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Codec r w (s a) i (a -> b) -> s a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s schema Codec r w (s a) i (a -> b) cf s (a -> a) -> s a -> s a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Codec r w (s a) i a -> s a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s schema Codec r w (s a) i a cx } instance ( Applicative.Alternative r , Applicative.Alternative w , Applicative s , Monoid a ) => Applicative.Alternative (Codec r w (s a) i) where empty :: Codec r w (s a) i a empty = Codec :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec { decode :: r a decode = r a forall (f :: * -> *) a. Alternative f => f a Applicative.empty , encode :: i -> w a encode = w a -> i -> w a forall a b. a -> b -> a const w a forall (f :: * -> *) a. Alternative f => f a Applicative.empty , schema :: s a schema = a -> s a forall (f :: * -> *) a. Applicative f => a -> f a pure a forall a. Monoid a => a mempty } Codec r w (s a) i a cx <|> :: Codec r w (s a) i a -> Codec r w (s a) i a -> Codec r w (s a) i a <|> Codec r w (s a) i a cy = Codec :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec { decode :: r a decode = Codec r w (s a) i a -> r a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o decode Codec r w (s a) i a cx r a -> r a -> r a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Codec r w (s a) i a -> r a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o decode Codec r w (s a) i a cy , encode :: i -> w a encode = \i i -> Codec r w (s a) i a -> i -> w a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o encode Codec r w (s a) i a cx i i w a -> w a -> w a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Codec r w (s a) i a -> i -> w a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o encode Codec r w (s a) i a cy i i , schema :: s a schema = a -> a -> a forall a. Semigroup a => a -> a -> a (<>) (a -> a -> a) -> s a -> s (a -> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Codec r w (s a) i a -> s a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s schema Codec r w (s a) i a cx s (a -> a) -> s a -> s a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Codec r w (s a) i a -> s a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s schema Codec r w (s a) i a cy } map :: (Functor r, Functor w) => (a -> b) -> (b -> a) -> Codec r w s a a -> Codec r w s b b map :: (a -> b) -> (b -> a) -> Codec r w s a a -> Codec r w s b b map a -> b f b -> a g Codec r w s a a c = Codec :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec { decode :: r b decode = a -> b f (a -> b) -> r a -> r b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Codec r w s a a -> r a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o decode Codec r w s a a c , encode :: b -> w b encode = (a -> b) -> w a -> w b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f (w a -> w b) -> (b -> w a) -> b -> w b forall b c a. (b -> c) -> (a -> b) -> a -> c . Codec r w s a a -> a -> w a forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o encode Codec r w s a a c (a -> w a) -> (b -> a) -> b -> w a forall b c a. (b -> c) -> (a -> b) -> a -> c . b -> a g , schema :: s schema = Codec r w s a a -> s forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s schema Codec r w s a a c } mapMaybe :: (Applicative.Alternative r, Applicative.Alternative w, Monad r, Monad w) => (o2 -> Maybe o1) -> (i1 -> Maybe i2) -> Codec r w s i2 o2 -> Codec r w s i1 o1 mapMaybe :: (o2 -> Maybe o1) -> (i1 -> Maybe i2) -> Codec r w s i2 o2 -> Codec r w s i1 o1 mapMaybe o2 -> Maybe o1 f i1 -> Maybe i2 g Codec r w s i2 o2 c = Codec :: forall (r :: * -> *) (w :: * -> *) s i o. r o -> (i -> w o) -> s -> Codec r w s i o Codec { decode :: r o1 decode = do o2 o2 <- Codec r w s i2 o2 -> r o2 forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o decode Codec r w s i2 o2 c Maybe o1 -> r o1 forall (m :: * -> *) a. Alternative m => Maybe a -> m a toAlternative (Maybe o1 -> r o1) -> Maybe o1 -> r o1 forall a b. (a -> b) -> a -> b $ o2 -> Maybe o1 f o2 o2 , encode :: i1 -> w o1 encode = \i1 i1 -> do i2 i2 <- Maybe i2 -> w i2 forall (m :: * -> *) a. Alternative m => Maybe a -> m a toAlternative (Maybe i2 -> w i2) -> Maybe i2 -> w i2 forall a b. (a -> b) -> a -> b $ i1 -> Maybe i2 g i1 i1 o2 o2 <- Codec r w s i2 o2 -> i2 -> w o2 forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o encode Codec r w s i2 o2 c i2 i2 Maybe o1 -> w o1 forall (m :: * -> *) a. Alternative m => Maybe a -> m a toAlternative (Maybe o1 -> w o1) -> Maybe o1 -> w o1 forall a b. (a -> b) -> a -> b $ o2 -> Maybe o1 f o2 o2 , schema :: s schema = Codec r w s i2 o2 -> s forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s schema Codec r w s i2 o2 c } project :: (i -> f) -> Codec r w s f o -> Codec r w s i o project :: (i -> f) -> Codec r w s f o -> Codec r w s i o project i -> f f Codec r w s f o c = Codec r w s f o c { encode :: i -> w o encode = Codec r w s f o -> f -> w o forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> i -> w o encode Codec r w s f o c (f -> w o) -> (i -> f) -> i -> w o forall b c a. (b -> c) -> (a -> b) -> a -> c . i -> f f } tap :: Functor f => (a -> f b) -> a -> f a tap :: (a -> f b) -> a -> f a tap a -> f b f a x = a x a -> f b -> f a forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ a -> f b f a x toAlternative :: Applicative.Alternative m => Maybe a -> m a toAlternative :: Maybe a -> m a toAlternative = m a -> (a -> m a) -> Maybe a -> m a forall b a. b -> (a -> b) -> Maybe a -> b maybe m a forall (f :: * -> *) a. Alternative f => f a Applicative.empty a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure