-- | Tier-1 library which provides Haskell implementations of hydra/lib/io primitives.

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

import Hydra.Core
import Hydra.Compute
import Hydra.Graph
import Hydra.Ext.Json.Coder
import Hydra.Dsl.Annotations
import Hydra.Ext.Json.Serde
import Hydra.CoreEncoding
import Hydra.Rewriting
import Hydra.Annotations
import Hydra.Tier1
import qualified Hydra.Json as Json
import qualified Hydra.Dsl.Terms as Terms
import qualified Hydra.Dsl.Types as Types

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


noGraph :: Graph
noGraph :: Graph
noGraph = Graph {
  graphElements :: Map Name Element
graphElements = Map Name Element
forall k a. Map k a
M.empty,
  graphEnvironment :: Map Name (Maybe Term)
graphEnvironment = Map Name (Maybe Term)
forall k a. Map k a
M.empty,
  graphTypes :: Map Name TypeScheme
graphTypes = Map Name TypeScheme
forall k a. Map k a
M.empty,
  graphBody :: Term
graphBody = [Term] -> Term
Terms.list [],
  graphPrimitives :: Map Name Primitive
graphPrimitives = Map Name Primitive
forall k a. Map k a
M.empty,
  graphSchema :: Maybe Graph
graphSchema = Maybe Graph
forall a. Maybe a
Nothing}


showTerm :: Term -> String
showTerm :: Term -> String
showTerm Term
term = String -> Graph -> Flow Graph String -> String
forall a s. a -> s -> Flow s a -> a
fromFlow String
"fail" Graph
noGraph (Value -> String
jsonValueToString (Value -> String) -> Flow Graph Value -> Flow Graph String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> Flow Graph Value
forall s. Term -> Flow s Value
untypedTermToJson Term
term)

--     coder <- termStringCoder
--     coderEncode coder encoded
--   where
--     --encoded = coreEncodeTerm $ rewriteTermMeta (const $ Kv M.empty) term
--     encoded = rewriteTermMeta (const $ Kv M.empty) term

termStringCoder :: Flow Graph (Coder Graph Graph Term String)
termStringCoder :: Flow Graph (Coder Graph Graph Term String)
termStringCoder = do
    Coder Graph Graph Term Value
termJsonCoder <- Type -> Flow Graph (Coder Graph Graph Term Value)
jsonCoder (Type -> Flow Graph (Coder Graph Graph Term Value))
-> Type -> Flow Graph (Coder Graph Graph Term Value)
forall a b. (a -> b) -> a -> b
$ Name -> Type
TypeVariable Name
_Term
    Coder Graph Graph Term String
-> Flow Graph (Coder Graph Graph Term String)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coder Graph Graph Term String
 -> Flow Graph (Coder Graph Graph Term String))
-> Coder Graph Graph Term String
-> Flow Graph (Coder Graph Graph Term String)
forall a b. (a -> b) -> a -> b
$ (Term -> Flow Graph String)
-> (String -> Flow Graph Term) -> Coder Graph Graph Term String
forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder (Coder Graph Graph Term Value -> Term -> Flow Graph String
forall {s1} {s2} {v1}. Coder s1 s2 v1 Value -> v1 -> Flow s1 String
mout Coder Graph Graph Term Value
termJsonCoder) (Coder Graph Graph Term Value -> String -> Flow Graph Term
forall {s1} {s2} {a}. Coder s1 s2 a Value -> String -> Flow s2 a
min Coder Graph Graph Term Value
termJsonCoder)
  where
    mout :: Coder s1 s2 v1 Value -> v1 -> Flow s1 String
mout Coder s1 s2 v1 Value
termJsonCoder v1
term = Value -> String
jsonValueToString (Value -> String) -> Flow s1 Value -> Flow s1 String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coder s1 s2 v1 Value -> v1 -> Flow s1 Value
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder s1 s2 v1 Value
termJsonCoder v1
term
    min :: Coder s1 s2 a Value -> String -> Flow s2 a
min Coder s1 s2 a Value
termJsonCoder String
s = case String -> Either String Value
stringToJsonValue String
s of
      Left String
msg -> String -> Flow s2 a
forall a. String -> Flow s2 a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow s2 a) -> String -> Flow s2 a
forall a b. (a -> b) -> a -> b
$ String
"failed to parse JSON value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
      Right Value
v -> Coder s1 s2 a Value -> Value -> Flow s2 a
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder s1 s2 a Value
termJsonCoder Value
v

--showType :: Type -> String
--showType typ = fromFlow "fail" noGraph $ do
--    coder <- typeStringCoder
--    coderEncode coder encoded
--  where
--    encoded = coreEncodeType $ rewriteTypeMeta (const $ Kv M.empty) typ

-- TODO: for now, we are bypassing the complexity of TermAdapters because of issues yet to be resolved
showType :: Type -> String
showType :: Type -> String
showType = Term -> String
showTerm (Term -> String) -> (Type -> Term) -> Type -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Term
coreEncodeType
--showType typ = case flowStateValue result of
--    Nothing -> "failed to encode type:\n" ++ show (traceMessages $ flowStateTrace result)
--    Just s -> s
--  where
--    result = unFlow (jsonValueToString <$> untypedTermToJson encoded) noGraph emptyTrace
--    encoded = stripTermRecursive $ coreEncodeType typ

typeStringCoder :: Flow Graph (Coder Graph Graph Term String)
typeStringCoder :: Flow Graph (Coder Graph Graph Term String)
typeStringCoder = do
    Coder Graph Graph Term Value
typeJsonCoder <- Type -> Flow Graph (Coder Graph Graph Term Value)
jsonCoder (Type -> Flow Graph (Coder Graph Graph Term Value))
-> Type -> Flow Graph (Coder Graph Graph Term Value)
forall a b. (a -> b) -> a -> b
$ Name -> Type
TypeVariable Name
_Type
    Coder Graph Graph Term String
-> Flow Graph (Coder Graph Graph Term String)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coder Graph Graph Term String
 -> Flow Graph (Coder Graph Graph Term String))
-> Coder Graph Graph Term String
-> Flow Graph (Coder Graph Graph Term String)
forall a b. (a -> b) -> a -> b
$ (Term -> Flow Graph String)
-> (String -> Flow Graph Term) -> Coder Graph Graph Term String
forall s1 s2 v1 v2.
(v1 -> Flow s1 v2) -> (v2 -> Flow s2 v1) -> Coder s1 s2 v1 v2
Coder (Coder Graph Graph Term Value -> Term -> Flow Graph String
forall {s1} {s2} {v1}. Coder s1 s2 v1 Value -> v1 -> Flow s1 String
mout Coder Graph Graph Term Value
typeJsonCoder) (Coder Graph Graph Term Value -> String -> Flow Graph Term
forall {s1} {s2} {a}. Coder s1 s2 a Value -> String -> Flow s2 a
min Coder Graph Graph Term Value
typeJsonCoder)
  where
    mout :: Coder s1 s2 v1 Value -> v1 -> Flow s1 String
mout Coder s1 s2 v1 Value
typeJsonCoder v1
term = Value -> String
jsonValueToString (Value -> String) -> Flow s1 Value -> Flow s1 String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coder s1 s2 v1 Value -> v1 -> Flow s1 Value
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v1 -> Flow s1 v2
coderEncode Coder s1 s2 v1 Value
typeJsonCoder v1
term
    min :: Coder s1 s2 a Value -> String -> Flow s2 a
min Coder s1 s2 a Value
typeJsonCoder String
s = case String -> Either String Value
stringToJsonValue String
s of
      Left String
msg -> String -> Flow s2 a
forall a. String -> Flow s2 a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow s2 a) -> String -> Flow s2 a
forall a b. (a -> b) -> a -> b
$ String
"failed to parse as JSON value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
      Right Value
v -> Coder s1 s2 a Value -> Value -> Flow s2 a
forall s1 s2 v1 v2. Coder s1 s2 v1 v2 -> v2 -> Flow s2 v1
coderDecode Coder s1 s2 a Value
typeJsonCoder Value
v