{-# LANGUAGE CPP #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
--------------------------------------------------------------------
-- |
-- Copyright :  © Edward Kmett 2010-2014, Johan Kiviniemi 2013
-- License   :  BSD3
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Ersatz.Codec
  ( Codec(..)
  ) where

import Control.Applicative
import Control.Monad hiding (mapM)
import Data.Array
import Data.HashMap.Lazy (HashMap)
import Data.IntMap (IntMap)
import Data.Map (Map)
import Data.Sequence (Seq)
import Data.Traversable
import Data.Tree (Tree)
import Ersatz.Internal.Literal
import Ersatz.Solution
import Prelude hiding (mapM)

-- | This class describes data types that can be marshaled to or from a SAT solver.
class Codec a where
  type Decoded a :: *
  -- | Return a value based on the solution if one can be determined.
#if __GLASGOW_HASKELL__ < 710
  decode :: (Alternative f, MonadPlus f) => Solution -> a -> f (Decoded a)
#else
  decode :: MonadPlus f => Solution -> a -> f (Decoded a)
#endif
  encode :: Decoded a -> a

instance Codec Literal where
  type Decoded Literal = Bool
  decode :: Solution -> Literal -> f (Decoded Literal)
decode Solution
s Literal
a = f Bool -> (Bool -> f Bool) -> Maybe Bool -> f Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False f Bool -> f Bool -> f Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Solution -> Literal -> Maybe Bool
solutionLiteral Solution
s Literal
a)
  encode :: Decoded Literal -> Literal
encode Decoded Literal
True  = Literal
literalTrue
  encode Decoded Literal
False = Literal
literalFalse

instance Codec () where
  type Decoded () = ()
  decode :: Solution -> () -> f (Decoded ())
decode Solution
_ () = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  encode :: Decoded () -> ()
encode   () = ()

instance (Codec a, Codec b) => Codec (a,b) where
  type Decoded (a,b) = (Decoded a, Decoded b)
  decode :: Solution -> (a, b) -> f (Decoded (a, b))
decode Solution
s (a
a,b
b) = (,) (Decoded a -> Decoded b -> (Decoded a, Decoded b))
-> f (Decoded a) -> f (Decoded b -> (Decoded a, Decoded b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s a
a f (Decoded b -> (Decoded a, Decoded b))
-> f (Decoded b) -> f (Decoded a, Decoded b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> b -> f (Decoded b)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s b
b
  encode :: Decoded (a, b) -> (a, b)
encode   (a,b) = (Decoded a -> a
forall a. Codec a => Decoded a -> a
encode Decoded a
a, Decoded b -> b
forall a. Codec a => Decoded a -> a
encode Decoded b
b)

instance (Codec a, Codec b, Codec c) => Codec (a,b,c) where
  type Decoded (a,b,c) = (Decoded a, Decoded b, Decoded c)
  decode :: Solution -> (a, b, c) -> f (Decoded (a, b, c))
decode Solution
s (a
a,b
b,c
c) = (,,) (Decoded a
 -> Decoded b -> Decoded c -> (Decoded a, Decoded b, Decoded c))
-> f (Decoded a)
-> f (Decoded b -> Decoded c -> (Decoded a, Decoded b, Decoded c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s a
a f (Decoded b -> Decoded c -> (Decoded a, Decoded b, Decoded c))
-> f (Decoded b)
-> f (Decoded c -> (Decoded a, Decoded b, Decoded c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> b -> f (Decoded b)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s b
b f (Decoded c -> (Decoded a, Decoded b, Decoded c))
-> f (Decoded c) -> f (Decoded a, Decoded b, Decoded c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> c -> f (Decoded c)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s c
c
  encode :: Decoded (a, b, c) -> (a, b, c)
encode   (a,b,c) = (Decoded a -> a
forall a. Codec a => Decoded a -> a
encode Decoded a
a, Decoded b -> b
forall a. Codec a => Decoded a -> a
encode Decoded b
b, Decoded c -> c
forall a. Codec a => Decoded a -> a
encode Decoded c
c)

instance (Codec a, Codec b, Codec c, Codec d) => Codec (a,b,c,d) where
  type Decoded (a,b,c,d) = (Decoded a, Decoded b, Decoded c, Decoded d)
  decode :: Solution -> (a, b, c, d) -> f (Decoded (a, b, c, d))
decode Solution
s (a
a,b
b,c
c,d
d) = (,,,) (Decoded a
 -> Decoded b
 -> Decoded c
 -> Decoded d
 -> (Decoded a, Decoded b, Decoded c, Decoded d))
-> f (Decoded a)
-> f (Decoded b
      -> Decoded c
      -> Decoded d
      -> (Decoded a, Decoded b, Decoded c, Decoded d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s a
a f (Decoded b
   -> Decoded c
   -> Decoded d
   -> (Decoded a, Decoded b, Decoded c, Decoded d))
-> f (Decoded b)
-> f (Decoded c
      -> Decoded d -> (Decoded a, Decoded b, Decoded c, Decoded d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> b -> f (Decoded b)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s b
b f (Decoded c
   -> Decoded d -> (Decoded a, Decoded b, Decoded c, Decoded d))
-> f (Decoded c)
-> f (Decoded d -> (Decoded a, Decoded b, Decoded c, Decoded d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> c -> f (Decoded c)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s c
c f (Decoded d -> (Decoded a, Decoded b, Decoded c, Decoded d))
-> f (Decoded d) -> f (Decoded a, Decoded b, Decoded c, Decoded d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> d -> f (Decoded d)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s d
d
  encode :: Decoded (a, b, c, d) -> (a, b, c, d)
encode   (a,b,c,d) = (Decoded a -> a
forall a. Codec a => Decoded a -> a
encode Decoded a
a, Decoded b -> b
forall a. Codec a => Decoded a -> a
encode Decoded b
b, Decoded c -> c
forall a. Codec a => Decoded a -> a
encode Decoded c
c, Decoded d -> d
forall a. Codec a => Decoded a -> a
encode Decoded d
d)

instance (Codec a, Codec b, Codec c, Codec d, Codec e) => Codec (a,b,c,d,e) where
  type Decoded (a,b,c,d,e) = (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e)
  decode :: Solution -> (a, b, c, d, e) -> f (Decoded (a, b, c, d, e))
decode Solution
s (a
a,b
b,c
c,d
d,e
e) = (,,,,) (Decoded a
 -> Decoded b
 -> Decoded c
 -> Decoded d
 -> Decoded e
 -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e))
-> f (Decoded a)
-> f (Decoded b
      -> Decoded c
      -> Decoded d
      -> Decoded e
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s a
a f (Decoded b
   -> Decoded c
   -> Decoded d
   -> Decoded e
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e))
-> f (Decoded b)
-> f (Decoded c
      -> Decoded d
      -> Decoded e
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> b -> f (Decoded b)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s b
b f (Decoded c
   -> Decoded d
   -> Decoded e
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e))
-> f (Decoded c)
-> f (Decoded d
      -> Decoded e
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> c -> f (Decoded c)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s c
c f (Decoded d
   -> Decoded e
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e))
-> f (Decoded d)
-> f (Decoded e
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> d -> f (Decoded d)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s d
d f (Decoded e
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e))
-> f (Decoded e)
-> f (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> e -> f (Decoded e)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s e
e
  encode :: Decoded (a, b, c, d, e) -> (a, b, c, d, e)
encode   (a,b,c,d,e) = (Decoded a -> a
forall a. Codec a => Decoded a -> a
encode Decoded a
a, Decoded b -> b
forall a. Codec a => Decoded a -> a
encode Decoded b
b, Decoded c -> c
forall a. Codec a => Decoded a -> a
encode Decoded c
c, Decoded d -> d
forall a. Codec a => Decoded a -> a
encode Decoded d
d, Decoded e -> e
forall a. Codec a => Decoded a -> a
encode Decoded e
e)

instance (Codec a, Codec b, Codec c, Codec d, Codec e, Codec f) => Codec (a,b,c,d,e,f) where
  type Decoded (a,b,c,d,e,f) = (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e, Decoded f)
  decode :: Solution -> (a, b, c, d, e, f) -> f (Decoded (a, b, c, d, e, f))
decode Solution
s (a
a,b
b,c
c,d
d,e
e,f
f) = (,,,,,) (Decoded a
 -> Decoded b
 -> Decoded c
 -> Decoded d
 -> Decoded e
 -> Decoded f
 -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
     Decoded f))
-> f (Decoded a)
-> f (Decoded b
      -> Decoded c
      -> Decoded d
      -> Decoded e
      -> Decoded f
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s a
a f (Decoded b
   -> Decoded c
   -> Decoded d
   -> Decoded e
   -> Decoded f
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f))
-> f (Decoded b)
-> f (Decoded c
      -> Decoded d
      -> Decoded e
      -> Decoded f
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> b -> f (Decoded b)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s b
b f (Decoded c
   -> Decoded d
   -> Decoded e
   -> Decoded f
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f))
-> f (Decoded c)
-> f (Decoded d
      -> Decoded e
      -> Decoded f
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> c -> f (Decoded c)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s c
c f (Decoded d
   -> Decoded e
   -> Decoded f
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f))
-> f (Decoded d)
-> f (Decoded e
      -> Decoded f
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> d -> f (Decoded d)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s d
d f (Decoded e
   -> Decoded f
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f))
-> f (Decoded e)
-> f (Decoded f
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> e -> f (Decoded e)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s e
e f (Decoded f
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f))
-> f (Decoded f)
-> f (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
      Decoded f)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> f -> f (Decoded f)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s f
f
  encode :: Decoded (a, b, c, d, e, f) -> (a, b, c, d, e, f)
encode   (a,b,c,d,e,f) = (Decoded a -> a
forall a. Codec a => Decoded a -> a
encode Decoded a
a, Decoded b -> b
forall a. Codec a => Decoded a -> a
encode Decoded b
b, Decoded c -> c
forall a. Codec a => Decoded a -> a
encode Decoded c
c, Decoded d -> d
forall a. Codec a => Decoded a -> a
encode Decoded d
d, Decoded e -> e
forall a. Codec a => Decoded a -> a
encode Decoded e
e, Decoded f -> f
forall a. Codec a => Decoded a -> a
encode Decoded f
f)

instance (Codec a, Codec b, Codec c, Codec d, Codec e, Codec f, Codec g) => Codec (a,b,c,d,e,f,g) where
  type Decoded (a,b,c,d,e,f,g) = (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e, Decoded f, Decoded g)
  decode :: Solution
-> (a, b, c, d, e, f, g) -> f (Decoded (a, b, c, d, e, f, g))
decode Solution
s (a
a,b
b,c
c,d
d,e
e,f
f,g
g) = (,,,,,,) (Decoded a
 -> Decoded b
 -> Decoded c
 -> Decoded d
 -> Decoded e
 -> Decoded f
 -> Decoded g
 -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
     Decoded f, Decoded g))
-> f (Decoded a)
-> f (Decoded b
      -> Decoded c
      -> Decoded d
      -> Decoded e
      -> Decoded f
      -> Decoded g
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s a
a f (Decoded b
   -> Decoded c
   -> Decoded d
   -> Decoded e
   -> Decoded f
   -> Decoded g
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g))
-> f (Decoded b)
-> f (Decoded c
      -> Decoded d
      -> Decoded e
      -> Decoded f
      -> Decoded g
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> b -> f (Decoded b)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s b
b f (Decoded c
   -> Decoded d
   -> Decoded e
   -> Decoded f
   -> Decoded g
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g))
-> f (Decoded c)
-> f (Decoded d
      -> Decoded e
      -> Decoded f
      -> Decoded g
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> c -> f (Decoded c)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s c
c f (Decoded d
   -> Decoded e
   -> Decoded f
   -> Decoded g
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g))
-> f (Decoded d)
-> f (Decoded e
      -> Decoded f
      -> Decoded g
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> d -> f (Decoded d)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s d
d f (Decoded e
   -> Decoded f
   -> Decoded g
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g))
-> f (Decoded e)
-> f (Decoded f
      -> Decoded g
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> e -> f (Decoded e)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s e
e f (Decoded f
   -> Decoded g
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g))
-> f (Decoded f)
-> f (Decoded g
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> f -> f (Decoded f)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s f
f f (Decoded g
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g))
-> f (Decoded g)
-> f (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
      Decoded f, Decoded g)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> g -> f (Decoded g)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s g
g
  encode :: Decoded (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g)
encode   (a,b,c,d,e,f,g) = (Decoded a -> a
forall a. Codec a => Decoded a -> a
encode Decoded a
a, Decoded b -> b
forall a. Codec a => Decoded a -> a
encode Decoded b
b, Decoded c -> c
forall a. Codec a => Decoded a -> a
encode Decoded c
c, Decoded d -> d
forall a. Codec a => Decoded a -> a
encode Decoded d
d, Decoded e -> e
forall a. Codec a => Decoded a -> a
encode Decoded e
e, Decoded f -> f
forall a. Codec a => Decoded a -> a
encode Decoded f
f, Decoded g -> g
forall a. Codec a => Decoded a -> a
encode Decoded g
g)

instance (Codec a, Codec b, Codec c, Codec d, Codec e, Codec f, Codec g, Codec h) => Codec (a,b,c,d,e,f,g,h) where
  type Decoded (a,b,c,d,e,f,g,h) = (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e, Decoded f, Decoded g, Decoded h)
  decode :: Solution
-> (a, b, c, d, e, f, g, h) -> f (Decoded (a, b, c, d, e, f, g, h))
decode Solution
s (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) = (,,,,,,,) (Decoded a
 -> Decoded b
 -> Decoded c
 -> Decoded d
 -> Decoded e
 -> Decoded f
 -> Decoded g
 -> Decoded h
 -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
     Decoded f, Decoded g, Decoded h))
-> f (Decoded a)
-> f (Decoded b
      -> Decoded c
      -> Decoded d
      -> Decoded e
      -> Decoded f
      -> Decoded g
      -> Decoded h
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g, Decoded h))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s a
a f (Decoded b
   -> Decoded c
   -> Decoded d
   -> Decoded e
   -> Decoded f
   -> Decoded g
   -> Decoded h
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g, Decoded h))
-> f (Decoded b)
-> f (Decoded c
      -> Decoded d
      -> Decoded e
      -> Decoded f
      -> Decoded g
      -> Decoded h
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g, Decoded h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> b -> f (Decoded b)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s b
b f (Decoded c
   -> Decoded d
   -> Decoded e
   -> Decoded f
   -> Decoded g
   -> Decoded h
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g, Decoded h))
-> f (Decoded c)
-> f (Decoded d
      -> Decoded e
      -> Decoded f
      -> Decoded g
      -> Decoded h
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g, Decoded h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> c -> f (Decoded c)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s c
c f (Decoded d
   -> Decoded e
   -> Decoded f
   -> Decoded g
   -> Decoded h
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g, Decoded h))
-> f (Decoded d)
-> f (Decoded e
      -> Decoded f
      -> Decoded g
      -> Decoded h
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g, Decoded h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> d -> f (Decoded d)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s d
d f (Decoded e
   -> Decoded f
   -> Decoded g
   -> Decoded h
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g, Decoded h))
-> f (Decoded e)
-> f (Decoded f
      -> Decoded g
      -> Decoded h
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g, Decoded h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> e -> f (Decoded e)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s e
e f (Decoded f
   -> Decoded g
   -> Decoded h
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g, Decoded h))
-> f (Decoded f)
-> f (Decoded g
      -> Decoded h
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g, Decoded h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> f -> f (Decoded f)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s f
f f (Decoded g
   -> Decoded h
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g, Decoded h))
-> f (Decoded g)
-> f (Decoded h
      -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
          Decoded f, Decoded g, Decoded h))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> g -> f (Decoded g)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s g
g f (Decoded h
   -> (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
       Decoded f, Decoded g, Decoded h))
-> f (Decoded h)
-> f (Decoded a, Decoded b, Decoded c, Decoded d, Decoded e,
      Decoded f, Decoded g, Decoded h)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Solution -> h -> f (Decoded h)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s h
h
  encode :: Decoded (a, b, c, d, e, f, g, h) -> (a, b, c, d, e, f, g, h)
encode   (a,b,c,d,e,f,g,h) = (Decoded a -> a
forall a. Codec a => Decoded a -> a
encode Decoded a
a, Decoded b -> b
forall a. Codec a => Decoded a -> a
encode Decoded b
b, Decoded c -> c
forall a. Codec a => Decoded a -> a
encode Decoded c
c, Decoded d -> d
forall a. Codec a => Decoded a -> a
encode Decoded d
d, Decoded e -> e
forall a. Codec a => Decoded a -> a
encode Decoded e
e, Decoded f -> f
forall a. Codec a => Decoded a -> a
encode Decoded f
f, Decoded g -> g
forall a. Codec a => Decoded a -> a
encode Decoded g
g, Decoded h -> h
forall a. Codec a => Decoded a -> a
encode Decoded h
h)

instance Codec a => Codec [a] where
  type Decoded [a] = [Decoded a]
  decode :: Solution -> [a] -> f (Decoded [a])
decode = (a -> f (Decoded a)) -> [a] -> f [Decoded a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((a -> f (Decoded a)) -> [a] -> f [Decoded a])
-> (Solution -> a -> f (Decoded a))
-> Solution
-> [a]
-> f [Decoded a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode
  encode :: Decoded [a] -> [a]
encode = (Decoded a -> a) -> [Decoded a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Decoded a -> a
forall a. Codec a => Decoded a -> a
encode

instance (Ix i, Codec e) => Codec (Array i e) where
  type Decoded (Array i e) = Array i (Decoded e)
  decode :: Solution -> Array i e -> f (Decoded (Array i e))
decode = (e -> f (Decoded e)) -> Array i e -> f (Array i (Decoded e))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((e -> f (Decoded e)) -> Array i e -> f (Array i (Decoded e)))
-> (Solution -> e -> f (Decoded e))
-> Solution
-> Array i e
-> f (Array i (Decoded e))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Solution -> e -> f (Decoded e)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode
  encode :: Decoded (Array i e) -> Array i e
encode = (Decoded e -> e) -> Array i (Decoded e) -> Array i e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decoded e -> e
forall a. Codec a => Decoded a -> a
encode

instance (Codec a, Codec b) => Codec (Either a b) where
  type Decoded (Either a b) = Either (Decoded a) (Decoded b)
  decode :: Solution -> Either a b -> f (Decoded (Either a b))
decode Solution
s (Left  a
a) = Decoded a -> Either (Decoded a) (Decoded b)
forall a b. a -> Either a b
Left  (Decoded a -> Either (Decoded a) (Decoded b))
-> f (Decoded a) -> f (Either (Decoded a) (Decoded b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s a
a
  decode Solution
s (Right b
b) = Decoded b -> Either (Decoded a) (Decoded b)
forall a b. b -> Either a b
Right (Decoded b -> Either (Decoded a) (Decoded b))
-> f (Decoded b) -> f (Either (Decoded a) (Decoded b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Solution -> b -> f (Decoded b)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode Solution
s b
b
  encode :: Decoded (Either a b) -> Either a b
encode   (Left  a) = a -> Either a b
forall a b. a -> Either a b
Left  (Decoded a -> a
forall a. Codec a => Decoded a -> a
encode Decoded a
a)
  encode   (Right b) = b -> Either a b
forall a b. b -> Either a b
Right (Decoded b -> b
forall a. Codec a => Decoded a -> a
encode Decoded b
b)

instance Codec a => Codec (HashMap k a) where
  type Decoded (HashMap k a) = HashMap k (Decoded a)
  decode :: Solution -> HashMap k a -> f (Decoded (HashMap k a))
decode = (a -> f (Decoded a)) -> HashMap k a -> f (HashMap k (Decoded a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((a -> f (Decoded a)) -> HashMap k a -> f (HashMap k (Decoded a)))
-> (Solution -> a -> f (Decoded a))
-> Solution
-> HashMap k a
-> f (HashMap k (Decoded a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode
  encode :: Decoded (HashMap k a) -> HashMap k a
encode = (Decoded a -> a) -> HashMap k (Decoded a) -> HashMap k a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decoded a -> a
forall a. Codec a => Decoded a -> a
encode

instance Codec a => Codec (IntMap a) where
  type Decoded (IntMap a) = IntMap (Decoded a)
  decode :: Solution -> IntMap a -> f (Decoded (IntMap a))
decode = (a -> f (Decoded a)) -> IntMap a -> f (IntMap (Decoded a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((a -> f (Decoded a)) -> IntMap a -> f (IntMap (Decoded a)))
-> (Solution -> a -> f (Decoded a))
-> Solution
-> IntMap a
-> f (IntMap (Decoded a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode
  encode :: Decoded (IntMap a) -> IntMap a
encode = (Decoded a -> a) -> IntMap (Decoded a) -> IntMap a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decoded a -> a
forall a. Codec a => Decoded a -> a
encode

instance Codec a => Codec (Map k a) where
  type Decoded (Map k a) = Map k (Decoded a)
  decode :: Solution -> Map k a -> f (Decoded (Map k a))
decode = (a -> f (Decoded a)) -> Map k a -> f (Map k (Decoded a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((a -> f (Decoded a)) -> Map k a -> f (Map k (Decoded a)))
-> (Solution -> a -> f (Decoded a))
-> Solution
-> Map k a
-> f (Map k (Decoded a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode
  encode :: Decoded (Map k a) -> Map k a
encode = (Decoded a -> a) -> Map k (Decoded a) -> Map k a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decoded a -> a
forall a. Codec a => Decoded a -> a
encode

instance Codec a => Codec (Maybe a) where
  type Decoded (Maybe a) = Maybe (Decoded a)
  decode :: Solution -> Maybe a -> f (Decoded (Maybe a))
decode = (a -> f (Decoded a)) -> Maybe a -> f (Maybe (Decoded a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((a -> f (Decoded a)) -> Maybe a -> f (Maybe (Decoded a)))
-> (Solution -> a -> f (Decoded a))
-> Solution
-> Maybe a
-> f (Maybe (Decoded a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode
  encode :: Decoded (Maybe a) -> Maybe a
encode = (Decoded a -> a) -> Maybe (Decoded a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decoded a -> a
forall a. Codec a => Decoded a -> a
encode

instance Codec a => Codec (Seq a) where
  type Decoded (Seq a) = Seq (Decoded a)
  decode :: Solution -> Seq a -> f (Decoded (Seq a))
decode = (a -> f (Decoded a)) -> Seq a -> f (Seq (Decoded a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((a -> f (Decoded a)) -> Seq a -> f (Seq (Decoded a)))
-> (Solution -> a -> f (Decoded a))
-> Solution
-> Seq a
-> f (Seq (Decoded a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode
  encode :: Decoded (Seq a) -> Seq a
encode = (Decoded a -> a) -> Seq (Decoded a) -> Seq a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decoded a -> a
forall a. Codec a => Decoded a -> a
encode

instance Codec a => Codec (Tree a) where
  type Decoded (Tree a) = Tree (Decoded a)
  decode :: Solution -> Tree a -> f (Decoded (Tree a))
decode = (a -> f (Decoded a)) -> Tree a -> f (Tree (Decoded a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((a -> f (Decoded a)) -> Tree a -> f (Tree (Decoded a)))
-> (Solution -> a -> f (Decoded a))
-> Solution
-> Tree a
-> f (Tree (Decoded a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Solution -> a -> f (Decoded a)
forall a (f :: * -> *).
(Codec a, MonadPlus f) =>
Solution -> a -> f (Decoded a)
decode
  encode :: Decoded (Tree a) -> Tree a
encode = (Decoded a -> a) -> Tree (Decoded a) -> Tree a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Decoded a -> a
forall a. Codec a => Decoded a -> a
encode