{-# language MultiParamTypeClasses, FunctionalDependencies #-}
{-# language FlexibleInstances, UndecidableInstances, FlexibleContexts #-}

module Satchmo.Code 

( Decode (..)
-- , Decoder
)

where

import Satchmo.Data

import Data.Array

import Control.Monad.Reader
import qualified Data.Map as M

class Monad m => Decode m c a where 
    decode :: c -> m a

-- type Decoder a = Reader ( Map Variable Bool ) a
-- type Decoder a = Reader ( Array Variable Bool ) a

instance Monad m => Decode m () () where
    decode :: () -> m ()
decode () = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance (  Decode m c a, Decode m d b ) => Decode m ( c,d) (a,b) where
    decode :: (c, d) -> m (a, b)
decode (c
c,d
d) = do a
a <- c -> m a
forall (m :: * -> *) c a. Decode m c a => c -> m a
decode c
c; b
b <- d -> m b
forall (m :: * -> *) c a. Decode m c a => c -> m a
decode d
d; (a, b) -> m (a, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( a
a,b
b)

instance (  Decode m c a ) => Decode m [c] [a] where
    decode :: [c] -> m [a]
decode = (c -> m a) -> [c] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM c -> m a
forall (m :: * -> *) c a. Decode m c a => c -> m a
decode 

instance Decode m a b => Decode m ( Maybe a ) ( Maybe b ) where
    decode :: Maybe a -> m (Maybe b)
decode ( Just a
b ) = do b
a <- a -> m b
forall (m :: * -> *) c a. Decode m c a => c -> m a
decode a
b ; Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> m (Maybe b)) -> Maybe b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
Just b
a
    decode Maybe a
Nothing = Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> m (Maybe b)) -> Maybe b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ Maybe b
forall a. Maybe a
Nothing

instance (Ix i, Decode m c a) => Decode m ( Array i c) ( Array i a ) where
    decode :: Array i c -> m (Array i a)
decode Array i c
x = do
        [(i, a)]
pairs <- [m (i, a)] -> m [(i, a)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m (i, a)] -> m [(i, a)]) -> [m (i, a)] -> m [(i, a)]
forall a b. (a -> b) -> a -> b
$ do
            (i
i,c
e) <- Array i c -> [(i, c)]
forall i e. Ix i => Array i e -> [(i, e)]
assocs Array i c
x
            m (i, a) -> [m (i, a)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (m (i, a) -> [m (i, a)]) -> m (i, a) -> [m (i, a)]
forall a b. (a -> b) -> a -> b
$ do
                a
f <- c -> m a
forall (m :: * -> *) c a. Decode m c a => c -> m a
decode c
e
                (i, a) -> m (i, a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (i
i,a
f)
        Array i a -> m (Array i a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Array i a -> m (Array i a)) -> Array i a -> m (Array i a)
forall a b. (a -> b) -> a -> b
$ (i, i) -> [(i, a)] -> Array i a
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Array i c -> (i, i)
forall i e. Array i e -> (i, i)
bounds Array i c
x) [(i, a)]
pairs

instance (Ord i, Decode m c a) => Decode m ( M.Map i c) ( M.Map i a ) where
    decode :: Map i c -> m (Map i a)
decode Map i c
x = do
        [(i, a)]
pairs <- [m (i, a)] -> m [(i, a)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m (i, a)] -> m [(i, a)]) -> [m (i, a)] -> m [(i, a)]
forall a b. (a -> b) -> a -> b
$ do
            (i
i,c
e) <- Map i c -> [(i, c)]
forall k a. Map k a -> [(k, a)]
M.assocs Map i c
x
            m (i, a) -> [m (i, a)]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (m (i, a) -> [m (i, a)]) -> m (i, a) -> [m (i, a)]
forall a b. (a -> b) -> a -> b
$ do
                a
f <- c -> m a
forall (m :: * -> *) c a. Decode m c a => c -> m a
decode c
e
                (i, a) -> m (i, a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (i
i,a
f)
        Map i a -> m (Map i a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map i a -> m (Map i a)) -> Map i a -> m (Map i a)
forall a b. (a -> b) -> a -> b
$ [(i, a)] -> Map i a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(i, a)]
pairs