module Hydra.Impl.Haskell.Dsl.Terms where import Hydra.All import qualified Hydra.Impl.Haskell.Dsl.Literals as Literals import Prelude hiding (map) import qualified Data.List as L import qualified Data.Map as M import qualified Data.Set as S import qualified Data.Maybe as Y import qualified Control.Monad as CM import Data.Int import Data.String(IsString(..)) instance IsString (Term m) where fromString :: String -> Term m fromString = forall m. String -> Term m string annot :: m -> Term m -> Term m annot :: forall m. m -> Term m -> Term m annot m ann Term m t = forall m. Annotated (Term m) m -> Term m TermAnnotated forall a b. (a -> b) -> a -> b $ forall a m. a -> m -> Annotated a m Annotated Term m t m ann apply :: Term m -> Term m -> Term m apply :: forall m. Term m -> Term m -> Term m apply Term m func Term m arg = forall m. Application m -> Term m TermApplication forall a b. (a -> b) -> a -> b $ forall m. Term m -> Term m -> Application m Application Term m func Term m arg bigfloat :: Double -> Term m bigfloat :: forall m. Double -> Term m bigfloat = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Double -> Literal Literals.bigfloat bigint :: Integer -> Term m bigint :: forall m. Integer -> Term m bigint = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Literal Literals.bigint binary :: String -> Term m binary :: forall m. String -> Term m binary = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Literal Literals.binary boolean :: Bool -> Term m boolean :: forall m. Bool -> Term m boolean = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Bool -> Literal Literals.boolean cases :: Name -> [Field m] -> Term m cases :: forall m. Name -> [Field m] -> Term m cases Name n [Field m] fields = forall m. Function m -> Term m TermFunction forall a b. (a -> b) -> a -> b $ forall m. Elimination m -> Function m FunctionElimination forall a b. (a -> b) -> a -> b $ forall m. CaseStatement m -> Elimination m EliminationUnion forall a b. (a -> b) -> a -> b $ forall m. Name -> [Field m] -> CaseStatement m CaseStatement Name n [Field m] fields compareTo :: Term m -> Term m compareTo :: forall m. Term m -> Term m compareTo = forall m. Function m -> Term m TermFunction forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Term m -> Function m FunctionCompareTo constFunction :: Term m -> Term m constFunction :: forall m. Term m -> Term m constFunction = forall m. String -> Term m -> Term m lambda String "_" delta :: Term m delta :: forall m. Term m delta = forall m. Function m -> Term m TermFunction forall a b. (a -> b) -> a -> b $ forall m. Elimination m -> Function m FunctionElimination forall m. Elimination m EliminationElement element :: Name -> Term m element :: forall m. Name -> Term m element = forall m. Name -> Term m TermElement elementRef :: Element a -> Term m elementRef :: forall a m. Element a -> Term m elementRef = forall m. Term m -> Term m -> Term m apply forall m. Term m delta forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Name -> Term m TermElement forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Element m -> Name elementName elementRefByName :: Name -> Term m elementRefByName :: forall m. Name -> Term m elementRefByName = forall m. Term m -> Term m -> Term m apply forall m. Term m delta forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Name -> Term m TermElement eliminateNominal :: Name -> Term m eliminateNominal :: forall m. Name -> Term m eliminateNominal = forall m. Function m -> Term m TermFunction forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Elimination m -> Function m FunctionElimination forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Name -> Elimination m EliminationNominal elimination :: Elimination m -> Term m elimination :: forall m. Elimination m -> Term m elimination = forall m. Function m -> Term m TermFunction forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Elimination m -> Function m FunctionElimination expectBinary :: Show m => Term m -> Flow s String expectBinary :: forall m s. Show m => Term m -> Flow s String expectBinary = forall m s a. Show m => (Literal -> Flow s a) -> Term m -> Flow s a expectLiteral forall s. Literal -> Flow s String Literals.expectBinary expectBoolean :: Show m => Term m -> Flow s Bool expectBoolean :: forall m s. Show m => Term m -> Flow s Bool expectBoolean = forall m s a. Show m => (Literal -> Flow s a) -> Term m -> Flow s a expectLiteral forall s. Literal -> Flow s Bool Literals.expectBoolean expectFloat32 :: Show m => Term m -> Flow s Float expectFloat32 :: forall m s. Show m => Term m -> Flow s Float expectFloat32 = forall m s a. Show m => (Literal -> Flow s a) -> Term m -> Flow s a expectLiteral forall s. Literal -> Flow s Float Literals.expectFloat32 expectFloat64 :: Show m => Term m -> Flow s Double expectFloat64 :: forall m s. Show m => Term m -> Flow s Double expectFloat64 = forall m s a. Show m => (Literal -> Flow s a) -> Term m -> Flow s a expectLiteral forall s. Literal -> Flow s Double Literals.expectFloat64 expectInt32 :: Show m => Term m -> Flow s Int expectInt32 :: forall m s. Show m => Term m -> Flow s Int expectInt32 = forall m s a. Show m => (Literal -> Flow s a) -> Term m -> Flow s a expectLiteral forall s. Literal -> Flow s Int Literals.expectInt32 expectInt64 :: Show m => Term m -> Flow s Integer expectInt64 :: forall m s. Show m => Term m -> Flow s Integer expectInt64 = forall m s a. Show m => (Literal -> Flow s a) -> Term m -> Flow s a expectLiteral forall s. Literal -> Flow s Integer Literals.expectInt64 expectList :: Show m => (Term m -> Flow s a) -> Term m -> Flow s [a] expectList :: forall m s a. Show m => (Term m -> Flow s a) -> Term m -> Flow s [a] expectList Term m -> Flow s a f Term m term = case forall m. Term m -> Term m stripTerm Term m term of TermList [Term m] l -> forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) CM.mapM Term m -> Flow s a f [Term m] l Term m _ -> forall (m :: * -> *) a1 a2. (MonadFail m, Show a1) => String -> a1 -> m a2 unexpected String "list" Term m term expectLiteral :: Show m => (Literal -> Flow s a) -> Term m -> Flow s a expectLiteral :: forall m s a. Show m => (Literal -> Flow s a) -> Term m -> Flow s a expectLiteral Literal -> Flow s a expect Term m term = case forall m. Term m -> Term m stripTerm Term m term of TermLiteral Literal lit -> Literal -> Flow s a expect Literal lit Term m _ -> forall (m :: * -> *) a1 a2. (MonadFail m, Show a1) => String -> a1 -> m a2 unexpected String "literal" Term m term expectMap :: (Ord k, Show m) => (Term m -> Flow s k) -> (Term m -> Flow s v) -> Term m -> Flow s (M.Map k v) expectMap :: forall k m s v. (Ord k, Show m) => (Term m -> Flow s k) -> (Term m -> Flow s v) -> Term m -> Flow s (Map k v) expectMap Term m -> Flow s k fk Term m -> Flow s v fv Term m term = case forall m. Term m -> Term m stripTerm Term m term of TermMap Map (Term m) (Term m) m -> forall k a. Ord k => [(k, a)] -> Map k a M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) CM.mapM (Term m, Term m) -> Flow s (k, v) expectPair (forall k a. Map k a -> [(k, a)] M.toList Map (Term m) (Term m) m) where expectPair :: (Term m, Term m) -> Flow s (k, v) expectPair (Term m kterm, Term m vterm) = do k kval <- Term m -> Flow s k fk Term m kterm v vval <- Term m -> Flow s v fv Term m vterm forall (m :: * -> *) a. Monad m => a -> m a return (k kval, v vval) Term m _ -> forall (m :: * -> *) a1 a2. (MonadFail m, Show a1) => String -> a1 -> m a2 unexpected String "map" Term m term expectNArgs :: Int -> [Term m] -> Flow s () expectNArgs :: forall m s. Int -> [Term m] -> Flow s () expectNArgs Int n [Term m] args = if forall (t :: * -> *) a. Foldable t => t a -> Int L.length [Term m] args forall a. Eq a => a -> a -> Bool /= Int n then forall (m :: * -> *) a1 a2. (MonadFail m, Show a1) => String -> a1 -> m a2 unexpected (forall a. Show a => a -> String show Int n forall a. [a] -> [a] -> [a] ++ String " arguments") (forall (t :: * -> *) a. Foldable t => t a -> Int L.length [Term m] args) else forall (f :: * -> *) a. Applicative f => a -> f a pure () expectOptional :: Show m => (Term m -> Flow s a) -> Term m -> Flow s (Y.Maybe a) expectOptional :: forall m s a. Show m => (Term m -> Flow s a) -> Term m -> Flow s (Maybe a) expectOptional Term m -> Flow s a f Term m term = case forall m. Term m -> Term m stripTerm Term m term of TermOptional Maybe (Term m) mt -> case Maybe (Term m) mt of Maybe (Term m) Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a pure forall a. Maybe a Nothing Just Term m t -> forall a. a -> Maybe a Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Term m -> Flow s a f Term m t Term m _ -> forall (m :: * -> *) a1 a2. (MonadFail m, Show a1) => String -> a1 -> m a2 unexpected String "optional value" Term m term expectRecord :: Show m => Term m -> Flow s [Field m] expectRecord :: forall m s. Show m => Term m -> Flow s [Field m] expectRecord Term m term = case forall m. Term m -> Term m stripTerm Term m term of TermRecord (Record Name _ [Field m] fields) -> forall (f :: * -> *) a. Applicative f => a -> f a pure [Field m] fields Term m _ -> forall (m :: * -> *) a1 a2. (MonadFail m, Show a1) => String -> a1 -> m a2 unexpected String "record" Term m term expectSet :: (Ord a, Show m) => (Term m -> Flow s a) -> Term m -> Flow s (S.Set a) expectSet :: forall a m s. (Ord a, Show m) => (Term m -> Flow s a) -> Term m -> Flow s (Set a) expectSet Term m -> Flow s a f Term m term = case forall m. Term m -> Term m stripTerm Term m term of TermSet Set (Term m) s -> forall a. Ord a => [a] -> Set a S.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) CM.mapM Term m -> Flow s a f (forall a. Set a -> [a] S.toList Set (Term m) s) Term m _ -> forall (m :: * -> *) a1 a2. (MonadFail m, Show a1) => String -> a1 -> m a2 unexpected String "set" Term m term expectString :: Show m => Term m -> Flow s String expectString :: forall m s. Show m => Term m -> Flow s String expectString = forall m s a. Show m => (Literal -> Flow s a) -> Term m -> Flow s a expectLiteral forall s. Literal -> Flow s String Literals.expectString expectUnion :: Show m => Term m -> Flow s (Field m) expectUnion :: forall m s. Show m => Term m -> Flow s (Field m) expectUnion Term m term = case forall m. Term m -> Term m stripTerm Term m term of TermUnion (Union Name _ Field m field) -> forall (f :: * -> *) a. Applicative f => a -> f a pure Field m field Term m _ -> forall (m :: * -> *) a1 a2. (MonadFail m, Show a1) => String -> a1 -> m a2 unexpected String "union" Term m term field :: String -> Term m -> Field m field :: forall m. String -> Term m -> Field m field String n = forall m. FieldName -> Term m -> Field m Field (String -> FieldName FieldName String n) fieldsToMap :: [Field m] -> M.Map FieldName (Term m) fieldsToMap :: forall m. [Field m] -> Map FieldName (Term m) fieldsToMap [Field m] fields = forall k a. Ord k => [(k, a)] -> Map k a M.fromList forall a b. (a -> b) -> a -> b $ (\(Field FieldName name Term m term) -> (FieldName name, Term m term)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Field m] fields float32 :: Float -> Term m float32 :: forall m. Float -> Term m float32 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Float -> Literal Literals.float32 float64 :: Double -> Term m float64 :: forall m. Double -> Term m float64 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Double -> Literal Literals.float64 float :: FloatValue -> Term m float :: forall m. FloatValue -> Term m float = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . FloatValue -> Literal Literals.float fold :: Term m -> Term m fold :: forall m. Term m -> Term m fold = forall m. Function m -> Term m TermFunction forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Elimination m -> Function m FunctionElimination forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Term m -> Elimination m EliminationList int16 :: Int16 -> Term m int16 :: forall m. Int16 -> Term m int16 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Int16 -> Literal Literals.int16 int32 :: Int -> Term m int32 :: forall m. Int -> Term m int32 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Literal Literals.int32 int64 :: Int64 -> Term m int64 :: forall m. Int64 -> Term m int64 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Int64 -> Literal Literals.int64 int8 :: Int8 -> Term m int8 :: forall m. Int8 -> Term m int8 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Int8 -> Literal Literals.int8 integer :: IntegerValue -> Term m integer :: forall m. IntegerValue -> Term m integer = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . IntegerValue -> Literal Literals.integer isUnit :: Eq m => Term m -> Bool isUnit :: forall m. Eq m => Term m -> Bool isUnit Term m t = forall m. Term m -> Term m stripTerm Term m t forall a. Eq a => a -> a -> Bool == forall m. Record m -> Term m TermRecord (forall m. Name -> [Field m] -> Record m Record Name unitTypeName []) lambda :: String -> Term m -> Term m lambda :: forall m. String -> Term m -> Term m lambda String param Term m body = forall m. Function m -> Term m TermFunction forall a b. (a -> b) -> a -> b $ forall m. Lambda m -> Function m FunctionLambda forall a b. (a -> b) -> a -> b $ forall m. Variable -> Term m -> Lambda m Lambda (String -> Variable Variable String param) Term m body letTerm :: Variable -> Term m -> Term m -> Term m letTerm :: forall m. Variable -> Term m -> Term m -> Term m letTerm Variable v Term m t1 Term m t2 = forall m. Let m -> Term m TermLet forall a b. (a -> b) -> a -> b $ forall m. Variable -> Term m -> Term m -> Let m Let Variable v Term m t1 Term m t2 list :: [Term m] -> Term m list :: forall m. [Term m] -> Term m list = forall m. [Term m] -> Term m TermList literal :: Literal -> Term m literal :: forall m. Literal -> Term m literal = forall m. Literal -> Term m TermLiteral map :: M.Map (Term m) (Term m) -> Term m map :: forall m. Map (Term m) (Term m) -> Term m map = forall m. Map (Term m) (Term m) -> Term m TermMap mapTerm :: M.Map (Term m) (Term m) -> Term m mapTerm :: forall m. Map (Term m) (Term m) -> Term m mapTerm = forall m. Map (Term m) (Term m) -> Term m TermMap match :: Name -> [(FieldName, Term m)] -> Term m match :: forall m. Name -> [(FieldName, Term m)] -> Term m match Name n = forall m. Name -> [Field m] -> Term m cases Name n forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall {m}. (FieldName, Term m) -> Field m toField where toField :: (FieldName, Term m) -> Field m toField (FieldName name, Term m term) = forall m. FieldName -> Term m -> Field m Field FieldName name Term m term matchOptional :: Term m -> Term m -> Term m matchOptional :: forall m. Term m -> Term m -> Term m matchOptional Term m n Term m j = forall m. Function m -> Term m TermFunction forall a b. (a -> b) -> a -> b $ forall m. Elimination m -> Function m FunctionElimination forall a b. (a -> b) -> a -> b $ forall m. OptionalCases m -> Elimination m EliminationOptional forall a b. (a -> b) -> a -> b $ forall m. Term m -> Term m -> OptionalCases m OptionalCases Term m n Term m j matchWithVariants :: Name -> [(FieldName, FieldName)] -> Term m matchWithVariants :: forall m. Name -> [(FieldName, FieldName)] -> Term m matchWithVariants Name n = forall m. Name -> [Field m] -> Term m cases Name n forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall {m}. (FieldName, FieldName) -> Field m toField where toField :: (FieldName, FieldName) -> Field m toField (FieldName from, FieldName to) = forall m. FieldName -> Term m -> Field m Field FieldName from forall a b. (a -> b) -> a -> b $ forall m. Term m -> Term m constFunction forall a b. (a -> b) -> a -> b $ forall m. Name -> FieldName -> Term m unitVariant Name n FieldName to nominal :: Name -> Term m -> Term m nominal :: forall m. Name -> Term m -> Term m nominal Name name Term m term = forall m. Named m -> Term m TermNominal forall a b. (a -> b) -> a -> b $ forall m. Name -> Term m -> Named m Named Name name Term m term optional :: Y.Maybe (Term m) -> Term m optional :: forall m. Maybe (Term m) -> Term m optional = forall m. Maybe (Term m) -> Term m TermOptional primitive :: Name -> Term m primitive :: forall m. Name -> Term m primitive = forall m. Function m -> Term m TermFunction forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Name -> Function m FunctionPrimitive product :: [Term m] -> Term m product :: forall m. [Term m] -> Term m product = forall m. [Term m] -> Term m TermProduct projection :: Name -> FieldName -> Term m projection :: forall m. Name -> FieldName -> Term m projection Name n FieldName fname = forall m. Function m -> Term m TermFunction forall a b. (a -> b) -> a -> b $ forall m. Elimination m -> Function m FunctionElimination forall a b. (a -> b) -> a -> b $ forall m. Projection -> Elimination m EliminationRecord forall a b. (a -> b) -> a -> b $ Name -> FieldName -> Projection Projection Name n FieldName fname record :: Name -> [Field m] -> Term m record :: forall m. Name -> [Field m] -> Term m record Name n [Field m] fields = forall m. Record m -> Term m TermRecord forall a b. (a -> b) -> a -> b $ forall m. Name -> [Field m] -> Record m Record Name n [Field m] fields requireField :: M.Map FieldName (Term m) -> FieldName -> GraphFlow m (Term m) requireField :: forall m. Map FieldName (Term m) -> FieldName -> GraphFlow m (Term m) requireField Map FieldName (Term m) fields FieldName fname = forall b a. b -> (a -> b) -> Maybe a -> b Y.maybe forall {a}. Flow (Context m) a err forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ forall k a. Ord k => k -> Map k a -> Maybe a M.lookup FieldName fname Map FieldName (Term m) fields where err :: Flow (Context m) a err = forall (m :: * -> *) a. MonadFail m => String -> m a fail forall a b. (a -> b) -> a -> b $ String "no such field: " forall a. [a] -> [a] -> [a] ++ FieldName -> String unFieldName FieldName fname set :: S.Set (Term m) -> Term m set :: forall m. Set (Term m) -> Term m set = forall m. Set (Term m) -> Term m TermSet stringList :: [String] -> Term m stringList :: forall m. [String] -> Term m stringList [String] l = forall m. [Term m] -> Term m list (forall m. String -> Term m string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [String] l) stringSet :: Ord m => S.Set String -> Term m stringSet :: forall m. Ord m => Set String -> Term m stringSet Set String strings = forall m. Set (Term m) -> Term m set forall a b. (a -> b) -> a -> b $ forall a. Ord a => [a] -> Set a S.fromList forall a b. (a -> b) -> a -> b $ forall m. String -> Term m string forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Set a -> [a] S.toList Set String strings string :: String -> Term m string :: forall m. String -> Term m string = forall m. Literal -> Term m TermLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Literal LiteralString sum :: Int -> Int -> Term m -> Term m sum :: forall m. Int -> Int -> Term m -> Term m sum Int i Int s Term m term = forall m. Sum m -> Term m TermSum forall a b. (a -> b) -> a -> b $ forall m. Int -> Int -> Term m -> Sum m Sum Int i Int s Term m term uint16 :: Integer -> Term m uint16 :: forall m. Integer -> Term m uint16 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Literal Literals.uint16 uint32 :: Integer -> Term m uint32 :: forall m. Integer -> Term m uint32 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Literal Literals.uint32 uint64 :: Integer -> Term m uint64 :: forall m. Integer -> Term m uint64 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Literal Literals.uint64 uint8 :: Integer -> Term m uint8 :: forall m. Integer -> Term m uint8 = forall m. Literal -> Term m literal forall b c a. (b -> c) -> (a -> b) -> a -> c . Integer -> Literal Literals.uint8 union :: Name -> Field m -> Term m union :: forall m. Name -> Field m -> Term m union Name n = forall m. Union m -> Term m TermUnion forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Name -> Field m -> Union m Union Name n unit :: Term m unit :: forall m. Term m unit = forall m. Record m -> Term m TermRecord forall a b. (a -> b) -> a -> b $ forall m. Name -> [Field m] -> Record m Record (String -> Name Name String "hydra/core.UnitType") [] unitVariant :: Name -> FieldName -> Term m unitVariant :: forall m. Name -> FieldName -> Term m unitVariant Name n FieldName fname = forall m. Name -> FieldName -> Term m -> Term m variant Name n FieldName fname forall m. Term m unit variable :: String -> Term m variable :: forall m. String -> Term m variable = forall m. Variable -> Term m TermVariable forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Variable Variable variant :: Name -> FieldName -> Term m -> Term m variant :: forall m. Name -> FieldName -> Term m -> Term m variant Name n FieldName fname Term m term = forall m. Union m -> Term m TermUnion forall a b. (a -> b) -> a -> b $ forall m. Name -> Field m -> Union m Union Name n forall a b. (a -> b) -> a -> b $ forall m. FieldName -> Term m -> Field m Field FieldName fname Term m term withVariant :: Name -> FieldName -> Term m withVariant :: forall m. Name -> FieldName -> Term m withVariant Name n = forall m. Term m -> Term m constFunction forall b c a. (b -> c) -> (a -> b) -> a -> c . forall m. Name -> FieldName -> Term m unitVariant Name n