Core.hs

{-# LANGUAGE FlexibleContexts #-}

-- | Haskell-specific convenience layer over the generated Hydra.Dsl.Core module.
-- Re-exports all generated DSL functions and adds AsTerm-flexible overrides
-- for functions commonly called with TypedBinding arguments.

module Hydra.Dsl.Meta.Core (
  module Hydra.Dsl.Core,
  module Hydra.Dsl.Meta.Core,
  nameLift,
) where

import Hydra.Kernel
import Hydra.Dsl.AsTerm
import Hydra.Dsl.Meta.Phantoms (nameLift, var, (~>))
import Hydra.Dsl.Core hiding (binding, injection, typeVariable)
import qualified Hydra.Dsl.Core as Gen

-- For helpers
import qualified Hydra.Dsl.Meta.Lib.Equality as Equality
import qualified Hydra.Dsl.Meta.Lib.Lists as Lists
import qualified Hydra.Dsl.Meta.Lib.Logic as Logic

import qualified Data.Map as M
import Prelude hiding (map, product)


-- | AsTerm-flexible overrides of generated functions.
-- These allow passing TypedBinding values where TypedTerm is expected.

binding :: AsTerm t Term => TypedTerm Name -> t -> TypedTerm (Maybe TypeScheme) -> TypedTerm Binding
binding n t ts = Gen.binding n (asTerm t) ts

equalNameList_ :: TypedTerm [Name] -> TypedTerm [Name] -> TypedTerm Bool
equalNameList_ lefts rights = Logic.and
  (Equality.equal (Lists.length lefts) (Lists.length rights))
  (Logic.ands $ Lists.zipWith equalName lefts rights)
  where
    equalName = "left" ~> "right" ~> Equality.equal
      (Gen.unName (var "left" :: TypedTerm Name))
      (Gen.unName (var "right" :: TypedTerm Name))

equalName_ :: TypedTerm Name -> TypedTerm Name -> TypedTerm Bool
equalName_ left right = Equality.equal (Gen.unName left) (Gen.unName right)

false :: TypedTerm Term
false = termLiteral $ literalBoolean $ TypedTerm $ TermLiteral $ LiteralBoolean False

injection :: AsTerm t Name => t -> TypedTerm Field -> TypedTerm Injection
injection n f = Gen.injection (asTerm n) f

typeVariable :: AsTerm t Name => t -> TypedTerm Type
typeVariable n = Gen.typeVariable (asTerm n)


-- | Non-standard helpers (used in kernel source modules)