{-# LANGUAGE FlexibleInstances #-}

module Argo.Internal.Codec.Codec where

import Control.Applicative ((<|>))

import qualified Control.Applicative as Applicative

data Codec r w s i o = Codec
    { forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o
decode :: r o
    , forall (r :: * -> *) (w :: * -> *) s i o.
Codec r w s i o -> i -> w o
encode :: i -> w o
    , forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s
schema :: s
    }

instance (Functor r, Functor w) => Functor (Codec r w s i) where
    fmap :: forall a b. (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
        { decode :: r b
decode = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 :: forall a. a -> Codec r w (s a) i a
pure a
x = Codec
        { decode :: r a
decode = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        , encode :: i -> w a
encode = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        , schema :: s a
schema = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
        }
    Codec r w (s a) i (a -> b)
cf <*> :: forall a b.
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
        { decode :: r b
decode = forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o
decode Codec r w (s a) i (a -> b)
cf forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 -> 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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s
schema Codec r w (s a) i (a -> b)
cf forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: forall a. Codec r w (s a) i a
empty = Codec
        { decode :: r a
decode = forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
        , encode :: i -> w a
encode = forall a b. a -> b -> a
const forall (f :: * -> *) a. Alternative f => f a
Applicative.empty
        , schema :: s a
schema = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
        }
    Codec r w (s a) i a
cx <|> :: forall a.
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
        { decode :: r a
decode = forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o
decode Codec r w (s a) i a
cx forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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 -> 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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f 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 = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> s
schema Codec r w (s a) i a
cx forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: forall (r :: * -> *) (w :: * -> *) a b s.
(Functor r, Functor w) =>
(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
    { decode :: r b
decode = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: * -> *) (w :: * -> *) s i o.
Codec r w s i o -> i -> w o
encode Codec r w s a a
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g
    , schema :: s
schema = 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 :: forall (r :: * -> *) (w :: * -> *) o2 o1 i1 i2 s.
(Alternative r, 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
f i1 -> Maybe i2
g Codec r w s i2 o2
c = Codec
    { decode :: r o1
decode = do
        o2
o2 <- forall (r :: * -> *) (w :: * -> *) s i o. Codec r w s i o -> r o
decode Codec r w s i2 o2
c
        forall (m :: * -> *) a. Alternative m => Maybe a -> m a
toAlternative forall a b. (a -> b) -> a -> b
$ o2 -> Maybe o1
f o2
o2
    , encode :: i1 -> w o1
encode = \i1
i1 -> do
        i2
i2 <- forall (m :: * -> *) a. Alternative m => Maybe a -> m a
toAlternative forall a b. (a -> b) -> a -> b
$ i1 -> Maybe i2
g i1
i1
        o2
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
        forall (m :: * -> *) a. Alternative m => Maybe a -> m a
toAlternative forall a b. (a -> b) -> a -> b
$ o2 -> Maybe o1
f o2
o2
    , schema :: s
schema = 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 :: forall i f (r :: * -> *) (w :: * -> *) s o.
(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 = forall (r :: * -> *) (w :: * -> *) s i o.
Codec r w s i o -> i -> w o
encode Codec r w s f o
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> f
f }

tap :: Functor f => (a -> f b) -> a -> f a
tap :: forall (f :: * -> *) a b. Functor f => (a -> f b) -> a -> f a
tap a -> f b
f a
x = a
x 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 :: forall (m :: * -> *) a. Alternative m => Maybe a -> m a
toAlternative = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
Applicative.empty forall (f :: * -> *) a. Applicative f => a -> f a
pure