module Hydra.Impl.Haskell.Dsl.Bootstrap where

import Hydra.All
import Hydra.Meta
import Hydra.CoreEncoding
import qualified Hydra.Impl.Haskell.Dsl.Types as Types

import qualified Data.Map as M
import qualified Data.Set as S


datatype :: Namespace -> String -> Type m -> Element m
datatype :: forall m. Namespace -> String -> Type m -> Element m
datatype Namespace
gname String
lname Type m
typ = forall m. Name -> Type m -> Element m
typeElement Name
elName forall a b. (a -> b) -> a -> b
$ forall a b.
((Type a -> Type b) -> Type a -> Type b)
-> (a -> b) -> Type a -> Type b
rewriteType forall {p} {m}. (p -> Type m) -> p -> Type m
replacePlaceholders forall a. a -> a
id Type m
typ
  where
    elName :: Name
elName = Namespace -> Name -> Name
qualify Namespace
gname (String -> Name
Name String
lname)

    -- Note: placeholders are only expected at the top level, or beneath annotations and/or type lambdas
    replacePlaceholders :: (p -> Type m) -> p -> Type m
replacePlaceholders p -> Type m
rec p
t = case Type m
t' of
        TypeRecord (RowType Name
n Maybe Name
e [FieldType m]
fields) -> if Name
n forall a. Eq a => a -> a -> Bool
== Name
placeholderName
          then forall m. RowType m -> Type m
TypeRecord (forall m. Name -> Maybe Name -> [FieldType m] -> RowType m
RowType Name
elName Maybe Name
e [FieldType m]
fields)
          else Type m
t'
        TypeUnion (RowType Name
n Maybe Name
e [FieldType m]
fields) -> if Name
n forall a. Eq a => a -> a -> Bool
== Name
placeholderName
          then forall m. RowType m -> Type m
TypeUnion (forall m. Name -> Maybe Name -> [FieldType m] -> RowType m
RowType Name
elName Maybe Name
e [FieldType m]
fields)
          else Type m
t'
        Type m
_ -> Type m
t'
      where
        t' :: Type m
t' = p -> Type m
rec p
t

bootstrapContext :: Context Meta
bootstrapContext :: Context Meta
bootstrapContext = Context Meta
cx
  where
    cx :: Context Meta
cx = Context {
      contextGraph :: Graph Meta
contextGraph = forall m. Map Name (Element m) -> Maybe (Graph m) -> Graph m
Graph forall k a. Map k a
M.empty forall a. Maybe a
Nothing,
      contextFunctions :: Map Name (PrimitiveFunction Meta)
contextFunctions = forall k a. Map k a
M.empty,
      contextStrategy :: EvaluationStrategy
contextStrategy = Set TermVariant -> EvaluationStrategy
EvaluationStrategy forall a. Set a
S.empty,
      contextAnnotations :: AnnotationClass Meta
contextAnnotations = AnnotationClass Meta
metaAnnotationClass}

nsref :: Namespace -> String -> Type m
nsref :: forall m. Namespace -> String -> Type m
nsref Namespace
ns = forall m. Name -> Type m
Types.nominal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Namespace -> Name -> Name
qualify Namespace
ns forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
Name

qualify :: Namespace -> Name -> Name
qualify :: Namespace -> Name -> Name
qualify (Namespace String
gname) (Name String
lname) = String -> Name
Name forall a b. (a -> b) -> a -> b
$ String
gname forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
lname

termElement :: Name -> Type m -> Term m -> Element m
termElement :: forall m. Name -> Type m -> Term m -> Element m
termElement Name
name Type m
typ Term m
term = Element {
  elementName :: Name
elementName = Name
name,
  elementSchema :: Term m
elementSchema = forall m. Type m -> Term m
encodeType Type m
typ,
  elementData :: Term m
elementData = Term m
term}

typeElement :: Name -> Type m -> Element m
typeElement :: forall m. Name -> Type m -> Element m
typeElement Name
name Type m
typ = Element {
  elementName :: Name
elementName = Name
name,
  elementSchema :: Term m
elementSchema = forall m. Name -> Term m
TermElement Name
_Type,
  elementData :: Term m
elementData = forall m. Type m -> Term m
encodeType Type m
typ}