-- | Haskell implementations of hydra/lib/io primitives

module Hydra.Lib.Io (
  showTerm,
  showType,
  coreContext,
) where

import Hydra.Kernel
import Hydra.Ext.Json.Coder
import qualified Hydra.Ext.Json.Model as Json
import Hydra.Impl.Haskell.Dsl.Standard
import qualified Hydra.Impl.Haskell.Dsl.Types as Types
import Hydra.Impl.Haskell.Ext.Json.Serde
import Hydra.CoreEncoding

import qualified Data.Map as M
import qualified Data.Maybe as Y


showTerm :: Ord m => Term m -> String
showTerm :: forall m. Ord m => Term m -> String
showTerm Term m
term = forall s a. s -> Flow s a -> a
fromFlow Context Meta
coreContext forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder (Context Meta) (Context Meta) (Term Meta) String
termStringCoder Term Meta
encoded
  where
    encoded :: Term Meta
encoded = forall m. Ord m => Term m -> Term m
encodeTerm forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Term a -> Term b
rewriteTermMeta (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Map String (Term Meta) -> Meta
Meta forall k a. Map k a
M.empty) Term m
term

termJsonCoder :: Coder (Context Meta) (Context Meta) (Term Meta) Json.Value
termJsonCoder :: Coder (Context Meta) (Context Meta) (Term Meta) Value
termJsonCoder = forall s a. s -> Flow s a -> a
fromFlow Context Meta
coreContext forall a b. (a -> b) -> a -> b
$ forall m.
(Eq m, Ord m, Read m, Show m) =>
Type m
-> GraphFlow m (Coder (Context m) (Context m) (Term m) Value)
jsonCoder forall a b. (a -> b) -> a -> b
$ forall m. Name -> Type m
Types.nominal Name
_Term

termStringCoder :: Coder (Context Meta) (Context Meta) (Term Meta) String
termStringCoder :: Coder (Context Meta) (Context Meta) (Term Meta) String
termStringCoder = forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder Term Meta -> Flow (Context Meta) String
mout String -> Flow (Context Meta) (Term Meta)
min
  where
    mout :: Term Meta -> Flow (Context Meta) String
mout Term Meta
term = Value -> String
valueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder (Context Meta) (Context Meta) (Term Meta) Value
termJsonCoder Term Meta
term
    min :: String -> Flow (Context Meta) (Term Meta)
min String
s = case String -> Either String Value
stringToValue String
s of
      Left String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"failed to parse JSON value: " forall a. [a] -> [a] -> [a]
++ String
msg
      Right Value
v -> forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder (Context Meta) (Context Meta) (Term Meta) Value
termJsonCoder Value
v

showType :: Ord m => Type m -> String
showType :: forall m. Ord m => Type m -> String
showType Type m
typ = forall s a. s -> Flow s a -> a
fromFlow Context Meta
coreContext forall a b. (a -> b) -> a -> b
$ forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder (Context Meta) (Context Meta) (Term Meta) String
typeStringCoder Term Meta
encoded
  where
    encoded :: Term Meta
encoded = forall m. Type m -> Term m
encodeType forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Type a -> Type b
rewriteTypeMeta (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Map String (Term Meta) -> Meta
Meta forall k a. Map k a
M.empty) Type m
typ

typeJsonCoder :: Coder (Context Meta) (Context Meta) (Term Meta) Json.Value
typeJsonCoder :: Coder (Context Meta) (Context Meta) (Term Meta) Value
typeJsonCoder = forall s a. s -> Flow s a -> a
fromFlow Context Meta
coreContext forall a b. (a -> b) -> a -> b
$ forall m.
(Eq m, Ord m, Read m, Show m) =>
Type m
-> GraphFlow m (Coder (Context m) (Context m) (Term m) Value)
jsonCoder forall a b. (a -> b) -> a -> b
$ forall m. Name -> Type m
Types.nominal Name
_Type

typeStringCoder :: Coder (Context Meta) (Context Meta) (Term Meta) String
typeStringCoder :: Coder (Context Meta) (Context Meta) (Term Meta) String
typeStringCoder = forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder Term Meta -> Flow (Context Meta) String
mout String -> Flow (Context Meta) (Term Meta)
min
  where
    mout :: Term Meta -> Flow (Context Meta) String
mout Term Meta
term = Value -> String
valueToString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder (Context Meta) (Context Meta) (Term Meta) Value
typeJsonCoder Term Meta
term
    min :: String -> Flow (Context Meta) (Term Meta)
min String
s = case String -> Either String Value
stringToValue String
s of
      Left String
msg -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"failed to parse as JSON value: " forall a. [a] -> [a] -> [a]
++ String
msg
      Right Value
v -> forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder (Context Meta) (Context Meta) (Term Meta) Value
typeJsonCoder Value
v