-- | Encoding-agnosting deserialization utilities.
{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ApplicativeDo         #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE ExplicitNamespaces    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeInType            #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
module Versioning.Internal.Decoding
  ( -- * Types
    Applied
  , Apply
  , ApplyM
  , DecodableTo
  , DecodableToFrom
  , DecodeAnyVersion
  , Decoder (..)
  , WithAnyVersion
  , WithAnyVersionFrom
    -- * Decoding and upgrading
  , decodeAnyVersion
  , decodeAnyVersionFrom
    -- * Decoding and applying an action
  , withAnyVersion
  , withAnyVersionM
  , withAnyVersionFromM
  , withAnyVersionFrom
  )
where

import           Data.Functor.Alt             (Alt (..))
import           Data.Functor.Identity        (Identity (..))
import           Data.Kind                    (Constraint, Type)

import           Versioning.Base
import           Versioning.Internal.Equality (type (==))
import           Versioning.Upgrade

-- | The result type of the action that has been applied to the decoded object
--   with 'withAnyVersion' or 'withAnyVersionM'.
type family Applied (c :: Type -> Constraint) (a :: V -> Type) :: Type

-- | The pure function to apply to the decoded object with 'withAnyVersion'
type Apply a c = forall v. c (a v) => a v -> Applied c a

-- | The action to apply to the decoded object with 'withAnyVersionM'
type ApplyM m a c = forall v. c (a v) => a v -> m (Applied c a)

-- | The function that will perform the actual decoding
newtype Decoder dec enc t a = Decoder (forall v. dec (a v) => enc -> t (a v))

-- | Handy constraint synonym to be used with 'decodeAnyVersion'
type DecodableTo dec v a = DecodableToFrom V0 dec v a

type DecodableToFrom from dec v a = DecodeAnyVersionFrom from v v a dec

decodeAnyVersion
  :: forall v a dec enc t
   . (Alt t, Applicative t, DecodableTo dec v a)
  => Decoder dec enc t a
  -> enc
  -> t (a v)
decodeAnyVersion :: Decoder dec enc t a -> enc -> t (a v)
decodeAnyVersion = forall (from :: V) (v :: V) (a :: V -> *) (dec :: * -> Constraint)
       enc (t :: * -> *).
(Alt t, Applicative t, DecodableToFrom from dec v a) =>
Decoder dec enc t a -> enc -> t (a v)
forall (v :: V) (a :: V -> *) (dec :: * -> Constraint) enc
       (t :: * -> *).
(Alt t, Applicative t, DecodableToFrom V0 dec v a) =>
Decoder dec enc t a -> enc -> t (a v)
decodeAnyVersionFrom @V0

-- | Decode by trying all the versions decrementally
--   and upgrade the decoded object to the newest version.
decodeAnyVersionFrom
  :: forall from v a dec enc t
   . (Alt t, Applicative t, DecodableToFrom from dec v a)
  => Decoder dec enc t a
  -> enc
  -> t (a v)
decodeAnyVersionFrom :: Decoder dec enc t a -> enc -> t (a v)
decodeAnyVersionFrom = forall (eq :: Bool) (from :: V) (v :: V) (w :: V) (a :: V -> *)
       (dec :: * -> Constraint) (t :: * -> *) enc.
(DecodeAnyVersion' eq from v w a dec, Alt t, Applicative t) =>
Decoder dec enc t a -> enc -> t (a w)
forall (a :: V -> *) (dec :: * -> Constraint) (t :: * -> *) enc.
(DecodeAnyVersion' (from == v) from v v a dec, Alt t,
 Applicative t) =>
Decoder dec enc t a -> enc -> t (a v)
decodeAnyVersion' @(from == v) @from @v @v

-- | Decode by trying all the versions decrementally
--   and apply an action to the decoded object at its original version.
withAnyVersionM
  :: forall v c a dec enc m t
   . (WithAnyVersion v a c dec, Alt t, Applicative t, Traversable t, Applicative m, c (a v))
  => Decoder dec enc t a
  -> ApplyM m a c
  -> enc
  -> m (t (Applied c a))
withAnyVersionM :: Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
withAnyVersionM = forall (from :: V) (v :: V) (c :: * -> Constraint) (a :: V -> *)
       (dec :: * -> Constraint) enc (m :: * -> *) (t :: * -> *).
(WithAnyVersionFrom from v a c dec, Alt t, Applicative t,
 Traversable t, Applicative m, c (a v)) =>
Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
forall (a :: V -> *) (dec :: * -> Constraint) enc (m :: * -> *)
       (t :: * -> *).
(WithAnyVersionFrom V0 v a c dec, Alt t, Applicative t,
 Traversable t, Applicative m, c (a v)) =>
Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
withAnyVersionFromM @V0 @v @c

-- | Like 'withAnyVersionM', with an additional type-parameter
--   indicating the oldest version you want to be able to decode
withAnyVersionFromM
  :: forall from v c a dec enc m t
   . (WithAnyVersionFrom from v a c dec, Alt t, Applicative t, Traversable t, Applicative m, c (a v))
  => Decoder dec enc t a
  -> ApplyM m a c
  -> enc
  -> m (t (Applied c a))
withAnyVersionFromM :: Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
withAnyVersionFromM = forall (m :: * -> *) (t :: * -> *) enc.
(WithAnyVersion' (from == v) from v a c dec, Applicative m, Alt t,
 Applicative t, Traversable t, c (a v)) =>
Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
forall (eq :: Bool) (from :: V) (v :: V) (a :: V -> *)
       (c :: * -> Constraint) (dec :: * -> Constraint) (m :: * -> *)
       (t :: * -> *) enc.
(WithAnyVersion' eq from v a c dec, Applicative m, Alt t,
 Applicative t, Traversable t, c (a v)) =>
Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
withAnyVersion' @(from == v) @from @v @a @c @dec

-- | Pure version of 'withAnyVersionM'.
withAnyVersion
  :: forall v c a dec enc t
   . (WithAnyVersion v a c dec, c (a v), Alt t, Applicative t, Traversable t)
  => Decoder dec enc t a
  -> Apply a c
  -> enc
  -> t (Applied c a)
withAnyVersion :: Decoder dec enc t a -> Apply a c -> enc -> t (Applied c a)
withAnyVersion Decoder dec enc t a
dec Apply a c
action =
  Identity (t (Applied c a)) -> t (Applied c a)
forall a. Identity a -> a
runIdentity (Identity (t (Applied c a)) -> t (Applied c a))
-> (enc -> Identity (t (Applied c a))) -> enc -> t (Applied c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder dec enc t a
-> ApplyM Identity a c -> enc -> Identity (t (Applied c a))
forall (v :: V) (c :: * -> Constraint) (a :: V -> *)
       (dec :: * -> Constraint) enc (m :: * -> *) (t :: * -> *).
(WithAnyVersion v a c dec, Alt t, Applicative t, Traversable t,
 Applicative m, c (a v)) =>
Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
withAnyVersionM @v @c @a Decoder dec enc t a
dec (Applied c a -> Identity (Applied c a)
forall a. a -> Identity a
Identity (Applied c a -> Identity (Applied c a))
-> (a v -> Applied c a) -> a v -> Identity (Applied c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a v -> Applied c a
Apply a c
action)

-- | Pure version of 'withAnyVersionFromM'.
withAnyVersionFrom
  :: forall from v c a dec enc t
   . (WithAnyVersionFrom from v a c dec, c (a v), Alt t, Applicative t, Traversable t)
  => Decoder dec enc t a
  -> Apply a c
  -> enc
  -> t (Applied c a)
withAnyVersionFrom :: Decoder dec enc t a -> Apply a c -> enc -> t (Applied c a)
withAnyVersionFrom Decoder dec enc t a
dec Apply a c
action =
  Identity (t (Applied c a)) -> t (Applied c a)
forall a. Identity a -> a
runIdentity (Identity (t (Applied c a)) -> t (Applied c a))
-> (enc -> Identity (t (Applied c a))) -> enc -> t (Applied c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decoder dec enc t a
-> ApplyM Identity a c -> enc -> Identity (t (Applied c a))
forall (from :: V) (v :: V) (c :: * -> Constraint) (a :: V -> *)
       (dec :: * -> Constraint) enc (m :: * -> *) (t :: * -> *).
(WithAnyVersionFrom from v a c dec, Alt t, Applicative t,
 Traversable t, Applicative m, c (a v)) =>
Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
withAnyVersionFromM @from @v @c @a Decoder dec enc t a
dec (Applied c a -> Identity (Applied c a)
forall a. a -> Identity a
Identity (Applied c a -> Identity (Applied c a))
-> (a v -> Applied c a) -> a v -> Identity (Applied c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a v -> Applied c a
Apply a c
action)

type DecodeAnyVersion v w a dec = DecodeAnyVersionFrom V0 v w a dec

type DecodeAnyVersionFrom from v w a dec = DecodeAnyVersion' (from == v) from v w a dec

class DecodeAnyVersion' (eq :: Bool) (from :: V) (v :: V) (w :: V) (a :: V -> Type) dec where
    decodeAnyVersion'
      :: (Alt t, Applicative t)
      => Decoder dec enc t a
      -> enc
      -> t (a w)

instance (from ~ v, dec (a from), Upgrade from w a)
  => DecodeAnyVersion' 'True from v w a dec where
    decodeAnyVersion' :: Decoder dec enc t a -> enc -> t (a w)
decodeAnyVersion' (Decoder forall (v :: V). dec (a v) => enc -> t (a v)
decode) enc
bs = forall (v :: V) (w :: V) (a :: V -> *). Upgrade v w a => a v -> a w
forall (a :: V -> *). Upgrade from w a => a from -> a w
upgrade @from @w (a from -> a w) -> t (a from) -> t (a w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> enc -> t (a from)
forall (v :: V). dec (a v) => enc -> t (a v)
decode @from enc
bs

instance (DecodeAnyVersion' (VPred v == from) from (VPred v) w a dec, dec (a v), dec (a (VPred v)), Upgrade v w a)
  => DecodeAnyVersion' 'False from v w a dec where
    decodeAnyVersion' :: Decoder dec enc t a -> enc -> t (a w)
decodeAnyVersion' decoder :: Decoder dec enc t a
decoder@(Decoder forall (v :: V). dec (a v) => enc -> t (a v)
decode) enc
bs = forall (v :: V) (w :: V) (a :: V -> *). Upgrade v w a => a v -> a w
forall (a :: V -> *). Upgrade v w a => a v -> a w
upgrade @v @w (a v -> a w) -> t (a v) -> t (a w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> enc -> t (a v)
forall (v :: V). dec (a v) => enc -> t (a v)
decode @v enc
bs
                                                t (a w) -> t (a w) -> t (a w)
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> Decoder dec enc t a -> enc -> t (a w)
forall (eq :: Bool) (from :: V) (v :: V) (w :: V) (a :: V -> *)
       (dec :: * -> Constraint) (t :: * -> *) enc.
(DecodeAnyVersion' eq from v w a dec, Alt t, Applicative t) =>
Decoder dec enc t a -> enc -> t (a w)
decodeAnyVersion' @(VPred v == from) @from @(VPred v) @w Decoder dec enc t a
decoder enc
bs

type WithAnyVersion v a c dec = WithAnyVersionFrom V0 v a c dec

type WithAnyVersionFrom from v a c dec = WithAnyVersion' (from == v) from v a c dec

class WithAnyVersion' (eq :: Bool) (from :: V) (v :: V) (a :: V -> Type) c dec where
    withAnyVersion' :: (Applicative m, Alt t, Applicative t, Traversable t, c (a v))
                    => Decoder dec enc t a
                    -> ApplyM m a c
                    -> enc
                    -> m (t (Applied c a))

instance (from ~ v, dec (a from), c (a from))
  => WithAnyVersion' 'True from v a c dec where
    withAnyVersion' :: Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
withAnyVersion' (Decoder forall (v :: V). dec (a v) => enc -> t (a v)
decode) ApplyM m a c
action enc
bs = (a from -> m (Applied c a)) -> t (a from) -> m (t (Applied c a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a from -> m (Applied c a)
ApplyM m a c
action (enc -> t (a from)
forall (v :: V). dec (a v) => enc -> t (a v)
decode @from enc
bs)

instance (WithAnyVersion' (VPred v == from) from (VPred v) a c dec, dec (a v), dec (a (VPred v)), c (a v), c (a (VPred v)))
  => WithAnyVersion' 'False from v a c dec where
    withAnyVersion' :: Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
withAnyVersion' dec :: Decoder dec enc t a
dec@(Decoder forall (v :: V). dec (a v) => enc -> t (a v)
decode) ApplyM m a c
action enc
bs = do
        t (Applied c a)
res  <- (a v -> m (Applied c a)) -> t (a v) -> m (t (Applied c a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a v -> m (Applied c a)
ApplyM m a c
action (enc -> t (a v)
forall (v :: V). dec (a v) => enc -> t (a v)
decode @v enc
bs)
        t (Applied c a)
next <- Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
forall (eq :: Bool) (from :: V) (v :: V) (a :: V -> *)
       (c :: * -> Constraint) (dec :: * -> Constraint) (m :: * -> *)
       (t :: * -> *) enc.
(WithAnyVersion' eq from v a c dec, Applicative m, Alt t,
 Applicative t, Traversable t, c (a v)) =>
Decoder dec enc t a -> ApplyM m a c -> enc -> m (t (Applied c a))
withAnyVersion' @(VPred v == from) @from @(VPred v) @a @c Decoder dec enc t a
dec ApplyM m a c
action enc
bs
        pure (t (Applied c a)
res t (Applied c a) -> t (Applied c a) -> t (Applied c a)
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> t (Applied c a)
next)