module Hydra.Impl.Haskell.Dsl.Prims where

import Hydra.All
import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms
import qualified Hydra.Impl.Haskell.Dsl.Types as Types

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y
--import Data.String(IsString(..))


--instance IsString (TermCoder m (Term m)) where fromString = variable

binaryPrimitive :: Name -> TermCoder m a -> TermCoder m b -> TermCoder m c -> (a -> b -> c) -> PrimitiveFunction m
binaryPrimitive :: forall m a b c.
Name
-> TermCoder m a
-> TermCoder m b
-> TermCoder m c
-> (a -> b -> c)
-> PrimitiveFunction m
binaryPrimitive Name
name TermCoder m a
input1 TermCoder m b
input2 TermCoder m c
output a -> b -> c
compute = forall m.
Name
-> FunctionType m
-> ([Term m] -> Flow (Context m) (Term m))
-> PrimitiveFunction m
PrimitiveFunction Name
name FunctionType m
ft [Term m] -> Flow (Context m) (Term m)
impl
  where
    ft :: FunctionType m
ft = forall m. Type m -> Type m -> FunctionType m
FunctionType (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m a
input1) (forall m. Type m -> Type m -> Type m
Types.function (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m b
input2) (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m c
output))
    impl :: [Term m] -> Flow (Context m) (Term m)
impl [Term m]
args = do
      forall m s. Int -> [Term m] -> Flow s ()
Terms.expectNArgs Int
2 [Term m]
args
      a
arg1 <- forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m a
input1) ([Term m]
args forall a. [a] -> Int -> a
!! Int
0)
      b
arg2 <- forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m b
input2) ([Term m]
args forall a. [a] -> Int -> a
!! Int
1)
      forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m c
output) forall a b. (a -> b) -> a -> b
$ a -> b -> c
compute a
arg1 b
arg2

boolean :: Show m => TermCoder m Bool
boolean :: forall m. Show m => TermCoder m Bool
boolean = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder forall m. Type m
Types.boolean forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder forall {s}. Term m -> Flow s Bool
encode forall {m}. Bool -> Flow (Context m) (Term m)
decode
  where
    encode :: Term m -> Flow s Bool
encode = forall m s. Show m => Term m -> Flow s Bool
Terms.expectBoolean
    decode :: Bool -> Flow (Context m) (Term m)
decode = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Bool -> Term m
Terms.boolean

flow :: TermCoder m s -> TermCoder m a -> TermCoder m (Flow s a)
flow :: forall m s a.
TermCoder m s -> TermCoder m a -> TermCoder m (Flow s a)
flow TermCoder m s
states TermCoder m a
values = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder (forall m. Name -> Type m
Types.nominal Name
_Flow forall m. Type m -> Type m -> Type m
Types.@@ (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m s
states) forall m. Type m -> Type m -> Type m
Types.@@ (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m a
values)) forall a b. (a -> b) -> a -> b
$
    forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
encode forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
decode
  where
    encode :: p -> m a
encode p
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"cannot currently encode flows from terms"
    decode :: p -> m a
decode p
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"cannot decode flows to terms"

function :: TermCoder m a -> TermCoder m b -> TermCoder m (a -> b)
function :: forall m a b.
TermCoder m a -> TermCoder m b -> TermCoder m (a -> b)
function TermCoder m a
dom TermCoder m b
cod = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder (forall m. Type m -> Type m -> Type m
Types.function (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m a
dom) (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m b
cod)) forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
encode forall {m :: * -> *} {p} {a}. MonadFail m => p -> m a
decode
  where
    encode :: p -> m a
encode p
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"cannot currently encode functions from terms"
    decode :: p -> m a
decode p
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"cannot decode functions to terms"

int32 :: Show m => TermCoder m Int
int32 :: forall m. Show m => TermCoder m Int
int32 = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder forall m. Type m
Types.int32 forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder forall {s}. Term m -> Flow s Int
encode forall {m}. Int -> Flow (Context m) (Term m)
decode
  where
    encode :: Term m -> Flow s Int
encode = forall m s. Show m => Term m -> Flow s Int
Terms.expectInt32
    decode :: Int -> Flow (Context m) (Term m)
decode = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Int -> Term m
Terms.int32

list :: Show m => TermCoder m a -> TermCoder m [a]
list :: forall m a. Show m => TermCoder m a -> TermCoder m [a]
list TermCoder m a
els = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder (forall m. Type m -> Type m
Types.list forall a b. (a -> b) -> a -> b
$ forall m a. TermCoder m a -> Type m
termCoderType TermCoder m a
els) forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder Term m -> Flow (Context m) [a]
encode [a] -> Flow (Context m) (Term m)
decode
  where
    encode :: Term m -> Flow (Context m) [a]
encode = forall m s a.
Show m =>
(Term m -> Flow s a) -> Term m -> Flow s [a]
Terms.expectList (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m a
els)
    decode :: [a] -> Flow (Context m) (Term m)
decode [a]
l = forall m. [Term m] -> Term m
Terms.list forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m a
els) [a]
l

map :: (Ord k, Ord m, Show m) => TermCoder m k -> TermCoder m v -> TermCoder m (M.Map k v)
map :: forall k m v.
(Ord k, Ord m, Show m) =>
TermCoder m k -> TermCoder m v -> TermCoder m (Map k v)
map TermCoder m k
keys TermCoder m v
values = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder (forall m. Type m -> Type m -> Type m
Types.map (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m k
keys) (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m v
values)) forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder Term m -> Flow (Context m) (Map k v)
encode Map k v -> Flow (Context m) (Term m)
decode
  where
    encode :: Term m -> Flow (Context m) (Map k v)
encode = forall k m s v.
(Ord k, Show m) =>
(Term m -> Flow s k)
-> (Term m -> Flow s v) -> Term m -> Flow s (Map k v)
Terms.expectMap (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m k
keys) (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m v
values)
    decode :: Map k v -> Flow (Context m) (Term m)
decode Map k v
m = forall m. Map (Term m) (Term m) -> Term m
Terms.map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (k, v) -> Flow (Context m) (Term m, Term m)
decodePair (forall k a. Map k a -> [(k, a)]
M.toList Map k v
m)
      where
        decodePair :: (k, v) -> Flow (Context m) (Term m, Term m)
decodePair (k
k, v
v) = do
          Term m
ke <- (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m k
keys) k
k
          Term m
ve <- (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m v
values) v
v
          forall (m :: * -> *) a. Monad m => a -> m a
return (Term m
ke, Term m
ve)

optional :: Show m => TermCoder m a -> TermCoder m (Y.Maybe a)
optional :: forall m a. Show m => TermCoder m a -> TermCoder m (Maybe a)
optional TermCoder m a
mel = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder (forall m. Type m -> Type m
Types.optional forall a b. (a -> b) -> a -> b
$ forall m a. TermCoder m a -> Type m
termCoderType TermCoder m a
mel) forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder Term m -> Flow (Context m) (Maybe a)
encode Maybe a -> Flow (Context m) (Term m)
decode
  where
    encode :: Term m -> Flow (Context m) (Maybe a)
encode = forall m s a.
Show m =>
(Term m -> Flow s a) -> Term m -> Flow s (Maybe a)
Terms.expectOptional (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m a
mel)
    decode :: Maybe a -> Flow (Context m) (Term m)
decode Maybe a
mv = forall m. Maybe (Term m) -> Term m
Terms.optional forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe a
mv of
      Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      Just a
v -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m a
mel) a
v

set :: (Ord a, Ord m, Show m) => TermCoder m a -> TermCoder m (S.Set a)
set :: forall a m.
(Ord a, Ord m, Show m) =>
TermCoder m a -> TermCoder m (Set a)
set TermCoder m a
els = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder (forall m. Type m -> Type m
Types.set forall a b. (a -> b) -> a -> b
$ forall m a. TermCoder m a -> Type m
termCoderType TermCoder m a
els) forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder Term m -> Flow (Context m) (Set a)
encode Set a -> Flow (Context m) (Term m)
decode
  where
    encode :: Term m -> Flow (Context m) (Set a)
encode = forall a m s.
(Ord a, Show m) =>
(Term m -> Flow s a) -> Term m -> Flow s (Set a)
Terms.expectSet (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m a
els)
    decode :: Set a -> Flow (Context m) (Term m)
decode Set a
s = forall m. Set (Term m) -> Term m
Terms.set forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
S.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode forall a b. (a -> b) -> a -> b
$ forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m a
els) (forall a. Set a -> [a]
S.toList Set a
s)

string :: Show m => TermCoder m String
string :: forall m. Show m => TermCoder m String
string = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder forall m. Type m
Types.string forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder forall {s}. Term m -> Flow s String
encode forall {m}. String -> Flow (Context m) (Term m)
decode
  where
    encode :: Term m -> Flow s String
encode = forall m s. Show m => Term m -> Flow s String
Terms.expectString
    decode :: String -> Flow (Context m) (Term m)
decode = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. String -> Term m
Terms.string

unaryPrimitive :: Name -> TermCoder m a -> TermCoder m b -> (a -> b) -> PrimitiveFunction m
unaryPrimitive :: forall m a b.
Name
-> TermCoder m a
-> TermCoder m b
-> (a -> b)
-> PrimitiveFunction m
unaryPrimitive Name
name TermCoder m a
input1 TermCoder m b
output a -> b
compute = forall m.
Name
-> FunctionType m
-> ([Term m] -> Flow (Context m) (Term m))
-> PrimitiveFunction m
PrimitiveFunction Name
name FunctionType m
ft [Term m] -> Flow (Context m) (Term m)
impl
  where
    ft :: FunctionType m
ft = forall m. Type m -> Type m -> FunctionType m
FunctionType (forall m a. TermCoder m a -> Type m
termCoderType TermCoder m a
input1) forall a b. (a -> b) -> a -> b
$ forall m a. TermCoder m a -> Type m
termCoderType TermCoder m b
output
    impl :: [Term m] -> Flow (Context m) (Term m)
impl [Term m]
args = do
      forall m s. Int -> [Term m] -> Flow s ()
Terms.expectNArgs Int
1 [Term m]
args
      a
arg1 <- forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode (forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m a
input1) ([Term m]
args forall a. [a] -> Int -> a
!! Int
0)
      forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode (forall m a.
TermCoder m a -> Coder (Context m) (Context m) (Term m) a
termCoderCoder TermCoder m b
output) forall a b. (a -> b) -> a -> b
$ a -> b
compute a
arg1

variable :: String -> TermCoder m (Term m)
variable :: forall m. String -> TermCoder m (Term m)
variable String
v = forall m a.
Type m -> Coder (Context m) (Context m) (Term m) a -> TermCoder m a
TermCoder (forall m. String -> Type m
Types.variable String
v) forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder forall {a}. a -> Flow (Context m) a
encode forall {a}. a -> Flow (Context m) a
decode
  where
    encode :: a -> Flow (Context m) a
encode = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    decode :: a -> Flow (Context m) a
decode = forall (f :: * -> *) a. Applicative f => a -> f a
pure