{-# 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