module Hydra.Impl.Haskell.Dsl.Standard (
  module Hydra.Impl.Haskell.Dsl.Standard,
  module Hydra.Impl.Haskell.Dsl.Bootstrap
) where

import Hydra.All
import Hydra.Meta
import Hydra.Impl.Haskell.Dsl.Terms as Terms
import qualified Hydra.Impl.Haskell.Dsl.Types as Types
import Hydra.Impl.Haskell.Sources.Libraries
import Hydra.Impl.Haskell.Sources.Core
import Hydra.Impl.Haskell.Dsl.Bootstrap

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


key_maxSize :: String
key_maxSize = String
"maxLength"
key_minSize :: String
key_minSize = String
"minLength"

annotateTerm :: String -> Y.Maybe (Term Meta) -> Term Meta -> Term Meta
annotateTerm :: String -> Maybe (Term Meta) -> Term Meta -> Term Meta
annotateTerm = Context Meta
-> String -> Maybe (Term Meta) -> Term Meta -> Term Meta
setTermAnnotation Context Meta
coreContext

annotateType :: String -> Y.Maybe (Term Meta) -> Type Meta -> Type Meta
annotateType :: String -> Maybe (Term Meta) -> Type Meta -> Type Meta
annotateType = Context Meta
-> String -> Maybe (Term Meta) -> Type Meta -> Type Meta
setTypeAnnotation Context Meta
coreContext

bounded :: Maybe Int -> Maybe Int -> Type Meta -> Type Meta
bounded :: Maybe Int -> Maybe Int -> Type Meta -> Type Meta
bounded Maybe Int
min Maybe Int
max = Type Meta -> Type Meta
annotMin forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type Meta -> Type Meta
annotMax
  where
    annotMax :: Type Meta -> Type Meta
annotMax Type Meta
t = forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe Type Meta
t (Int -> Type Meta -> Type Meta
`setMaxLength` Type Meta
t) Maybe Int
max
    annotMin :: Type Meta -> Type Meta
annotMin Type Meta
t = forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe Type Meta
t (Int -> Type Meta -> Type Meta
`setMinLength` Type Meta
t) Maybe Int
max

boundedList :: Maybe Int -> Maybe Int -> Type Meta -> Type Meta
boundedList :: Maybe Int -> Maybe Int -> Type Meta -> Type Meta
boundedList Maybe Int
min Maybe Int
max Type Meta
et = Maybe Int -> Maybe Int -> Type Meta -> Type Meta
bounded Maybe Int
min Maybe Int
max forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
Types.list Type Meta
et

boundedSet :: Maybe Int -> Maybe Int -> Type Meta -> Type Meta
boundedSet :: Maybe Int -> Maybe Int -> Type Meta -> Type Meta
boundedSet Maybe Int
min Maybe Int
max Type Meta
et = Maybe Int -> Maybe Int -> Type Meta -> Type Meta
bounded Maybe Int
min Maybe Int
max forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m
Types.set Type Meta
et

boundedString :: Maybe Int -> Maybe Int -> Type Meta
boundedString :: Maybe Int -> Maybe Int -> Type Meta
boundedString Maybe Int
min Maybe Int
max = Maybe Int -> Maybe Int -> Type Meta -> Type Meta
bounded Maybe Int
min Maybe Int
max forall m. Type m
Types.string

coreContext :: Context Meta
coreContext :: Context Meta
coreContext = Context Meta
bootstrapContext {
  contextGraph :: Graph Meta
contextGraph = Graph Meta
hydraCore,
  contextFunctions :: Map Name (PrimitiveFunction Meta)
contextFunctions = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PrimitiveFunction Meta
p -> (forall m. PrimitiveFunction m -> Name
primitiveFunctionName PrimitiveFunction Meta
p, PrimitiveFunction Meta
p)) forall m. (Ord m, Show m) => [PrimitiveFunction m]
standardPrimitives}

doc :: String -> Type Meta -> Type Meta
doc :: String -> Type Meta -> Type Meta
doc String
s = Context Meta -> Maybe String -> Type Meta -> Type Meta
setTypeDescription Context Meta
coreContext (forall a. a -> Maybe a
Just String
s)

dataDoc :: String -> Term Meta -> Term Meta
dataDoc :: String -> Term Meta -> Term Meta
dataDoc String
s = Context Meta -> Maybe String -> Term Meta -> Term Meta
setTermDescription Context Meta
coreContext (forall a. a -> Maybe a
Just String
s)

dataterm :: Namespace -> String -> Type Meta -> Term Meta -> Element Meta
dataterm :: Namespace -> String -> Type Meta -> Term Meta -> Element Meta
dataterm Namespace
gname String
lname = forall m. Name -> Type m -> Term m -> Element m
termElement (Namespace -> Name -> Name
qualify Namespace
gname (String -> Name
Name String
lname))

graphContext :: Graph Meta -> Context Meta
graphContext :: Graph Meta -> Context Meta
graphContext Graph Meta
g = Context Meta
coreContext {contextGraph :: Graph Meta
contextGraph = Graph Meta
g}

nonemptyList :: Type Meta -> Type Meta
nonemptyList :: Type Meta -> Type Meta
nonemptyList = Maybe Int -> Maybe Int -> Type Meta -> Type Meta
boundedList (forall a. a -> Maybe a
Just Int
1) forall a. Maybe a
Nothing

note :: String -> Type Meta -> Type Meta
note :: String -> Type Meta -> Type Meta
note String
s = String -> Type Meta -> Type Meta
doc forall a b. (a -> b) -> a -> b
$ String
"Note: " forall a. [a] -> [a] -> [a]
++ String
s

see :: String -> Type Meta -> Type Meta
see :: String -> Type Meta -> Type Meta
see String
s = String -> Type Meta -> Type Meta
doc forall a b. (a -> b) -> a -> b
$ String
"See " forall a. [a] -> [a] -> [a]
++ String
s

setMaxLength :: Int -> Type Meta -> Type Meta
setMaxLength :: Int -> Type Meta -> Type Meta
setMaxLength Int
m = Context Meta
-> String -> Maybe (Term Meta) -> Type Meta -> Type Meta
setTypeAnnotation Context Meta
coreContext String
key_maxSize (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall m. Int -> Term m
Terms.int32 Int
m)

setMinLength :: Int -> Type Meta -> Type Meta
setMinLength :: Int -> Type Meta -> Type Meta
setMinLength Int
m = Context Meta
-> String -> Maybe (Term Meta) -> Type Meta -> Type Meta
setTypeAnnotation Context Meta
coreContext String
key_minSize (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall m. Int -> Term m
Terms.int32 Int
m)

standardGraph :: [Element Meta] -> Graph Meta
standardGraph :: [Element Meta] -> Graph Meta
standardGraph = forall m. Maybe (Graph m) -> [Element m] -> Graph m
elementsToGraph (forall a. a -> Maybe a
Just Graph Meta
hydraCore)

twoOrMoreList :: Type Meta -> Type Meta
twoOrMoreList :: Type Meta -> Type Meta
twoOrMoreList = Maybe Int -> Maybe Int -> Type Meta -> Type Meta
boundedList (forall a. a -> Maybe a
Just Int
2) forall a. Maybe a
Nothing