{-# LANGUAGE TemplateHaskellQuotes #-}

-- | Generate the unit type and function to work with them

module Math.Haskellator.Internal.TH.UnitGeneration (
      Quantity (..)
    , UnitDef (..)
    , Value (..)
    , generateUnits
    ) where

import Data.Char

import Language.Haskell.TH
import Language.Haskell.TH.Syntax

-- | Definition of a Unit
data UnitDef = UnitDef String String Double

-- | A quantity made of a base unit and other related units
data Quantity = Quantity UnitDef [UnitDef]

-- | A simple representation of a value with a unit. The unit's type is parameterized,
-- since the unit can be a simple 'Unit' or a 'Dimension'.
data Value u = Value { forall u. Value u -> Double
value :: Double
                     , forall u. Value u -> u
unit  :: u
                     }

instance Show u => Show (Value u) where
    show :: Value u -> String
show (Value Double
v u
u) = Double -> String
forall a. Show a => a -> String
show Double
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ if u -> String
forall a. Show a => a -> String
show u
u String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
"" else String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ u -> String
forall a. Show a => a -> String
show u
u

unitADT :: Name
unitADT :: Name
unitADT = String -> Name
mkName String
"Unit"

unitExpADT :: Name
unitExpADT :: Name
unitExpADT = String -> Name
mkName String
"UnitExp"

unitFromStringFun :: Name
unitFromStringFun :: Name
unitFromStringFun = String -> Name
mkName String
"unitFromString"

convertToBaseFun :: Name
convertToBaseFun :: Name
convertToBaseFun = String -> Name
mkName String
"convertToBase"

convertToFun :: Name
convertToFun :: Name
convertToFun = String -> Name
mkName String
"convertTo"

-- | Generate the unit types and function to work with them. Imagine the following call: @generateUnits [Quantity (UnitDef "Meter" "m" 1) [UnitDef "Kilometer" "km" 1000]]@.
-- This function will then generate the following code:
--
--     * A data type with all the units
--
-- > data Unit = Meter Int | Kilometer Int
--
--     * An instance of Show for the data type
--
-- > instance Show Unit where -- e is the exponent (is not equal to 1)
-- >   show Meter = "m^e"
-- >   show Kilometer = "km^e"
--
--     * A function to convert a string to a unit
--
-- > unitFromString :: String -> Either String Unit
-- > unitFromString "m" = Right (Meter 1)
-- > unitFromString "km" = Right (Kilometer 1)
-- > unitFromString x = Left x
--
--     * A function to convert a value to the base unit
--
-- > convertToBase :: Value UnitExp -> Value UnitExp
-- > convertToBase (Value v (Meter e)) = Value ((v * 1.0) ^ e) (Meter e)
-- > convertToBase (Value v (KiloMeter e)) = Value ((v * 0.0001) ^ e) (Meter e)
--
--     * A function to convert a base unit to another unit
--
-- > convertTo :: Value UnitExp -> UnitExp -> Maybe (Value UnitExp)
-- > convertTo (Value v (UnitExp Meter es)) (UnitExp Meter et) | es == et = (Just $ Value (v / (1.0 ** fromIntegral es)) (UnitExp Meter es))
-- >                                                           | otherwise = Nothing
-- > convertTo (Value v (UnitExp Meter es)) (UnitExp Kilometer et) | es == et = Just $ Value (v / (1000.0 ** fromIntegral es)) (UnitExp Kilometer et)
-- >                                                               | otherwise = Nothing
-- > convertTo _ _ = Nothing
--
--     * A function to check whether a given unit is a specific unit
--
-- > isMeter :: Unit -> Bool
-- > isMeter (Meter _) = True
-- > isMeter _ = False
-- > isKilometer :: Unit -> Bool
-- > isKilometer (Kilometer _) = True
-- > isKilometer _ = False
--
--     * A function that creates a UnitExp
--
-- > meter :: Int -> UnitExp
-- > meter e = UnitExp $ Meter e
-- > kilometers :: Int -> UnitExp
-- > kilometers e = UnitExp $ Kilometer e
generateUnits :: [Quantity] -> Q [Dec]
generateUnits :: [Quantity] -> Q [Dec]
generateUnits [Quantity]
unitGroups = do
  let allUnits :: [UnitDef]
allUnits           = (Quantity -> [UnitDef]) -> [Quantity] -> [UnitDef]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Quantity UnitDef
b [UnitDef]
us) -> UnitDef
bUnitDef -> [UnitDef] -> [UnitDef]
forall a. a -> [a] -> [a]
:[UnitDef]
us) [Quantity]
unitGroups
      unitConstructors :: [Con]
unitConstructors   = UnitDef -> Con
mkConstructor (UnitDef -> Con) -> [UnitDef] -> [Con]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnitDef]
allUnits
      showClauses :: [Clause]
showClauses        = UnitDef -> Clause
mkShowClause (UnitDef -> Clause) -> [UnitDef] -> [Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnitDef]
allUnits
      fromStringClauses :: [Clause]
fromStringClauses  = (UnitDef -> Clause
mkFromStringClause (UnitDef -> Clause) -> [UnitDef] -> [Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UnitDef]
allUnits) -- RightCases
        [Clause] -> [Clause] -> [Clause]
forall a. [a] -> [a] -> [a]
++ [[Pat] -> Body -> [Dec] -> Clause
Clause [Name -> Pat
VarP (Name -> Pat) -> Name -> Pat
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"x"] (Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'Left) (Name -> Exp
VarE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"x")) []] -- Left case
      convertBaseClauses :: [Q Clause]
convertBaseClauses = (Quantity -> [Q Clause]) -> [Quantity] -> [Q Clause]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Quantity UnitDef
b [UnitDef]
us) -> UnitDef -> UnitDef -> Q Clause
mkConvertBaseClaus UnitDef
b (UnitDef -> Q Clause) -> [UnitDef] -> [Q Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnitDef
bUnitDef -> [UnitDef] -> [UnitDef]
forall a. a -> [a] -> [a]
:[UnitDef]
us) [Quantity]
unitGroups
      convertToClauses :: [Q Clause]
convertToClauses   = (Quantity -> [Q Clause]) -> [Quantity] -> [Q Clause]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Quantity UnitDef
b [UnitDef]
us) -> UnitDef -> UnitDef -> Q Clause
mkConvertToClaus UnitDef
b (UnitDef -> Q Clause) -> [UnitDef] -> [Q Clause]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnitDef
bUnitDef -> [UnitDef] -> [UnitDef]
forall a. a -> [a] -> [a]
:[UnitDef]
us) [Quantity]
unitGroups [Q Clause] -> [Q Clause] -> [Q Clause]
forall a. [a] -> [a] -> [a]
++ [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Q Pat
forall (m :: * -> *). Quote m => m Pat
wildP, Q Pat
forall (m :: * -> *). Quote m => m Pat
wildP] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$ Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE 'Nothing) []]

      dataDec :: Dec
dataDec            = Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Kind
-> [Con]
-> [DerivClause]
-> Dec
DataD [] Name
unitADT [] Maybe Kind
forall a. Maybe a
Nothing [Con]
unitConstructors [Maybe DerivStrategy -> Cxt -> DerivClause
DerivClause Maybe DerivStrategy
forall a. Maybe a
Nothing [Name -> Kind
ConT ''Lift, Name -> Kind
ConT ''Eq, Name -> Kind
ConT ''Bounded, Name -> Kind
ConT ''Enum]]
      showInstance :: Dec
showInstance       = Maybe Overlap -> Cxt -> Kind -> [Dec] -> Dec
InstanceD Maybe Overlap
forall a. Maybe a
Nothing [] (Kind -> Kind -> Kind
AppT (Name -> Kind
ConT ''Show) (Name -> Kind
ConT Name
unitADT)) [Name -> [Clause] -> Dec
FunD 'show [Clause]
showClauses]
      fromStringFunction :: Dec
fromStringFunction = Name -> [Clause] -> Dec
FunD Name
unitFromStringFun [Clause]
fromStringClauses

  Dec
fromStringSig   <- Name -> Q Kind -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Kind -> m Dec
sigD Name
unitFromStringFun [t|String -> Either String $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
unitADT)|]
  Dec
convertToSig    <- Name -> Q Kind -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Kind -> m Dec
sigD Name
convertToFun [t|Value $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
unitExpADT) -> $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
unitExpADT) -> Maybe (Value $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
unitExpADT))|]
  Dec
convertToFunc   <- Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
convertToFun [Q Clause]
convertToClauses
  Dec
convertBaseSig  <- Name -> Q Kind -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Kind -> m Dec
sigD Name
convertToBaseFun [t|Value $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
unitExpADT) -> Value $(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
unitExpADT)|]
  Dec
convertBaseFunc <- Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
convertToBaseFun [Q Clause]
convertBaseClauses
  [Dec]
mkUnitFuns      <- [Quantity] -> Q [Dec]
generateMkUnitFuns [Quantity]
unitGroups
  [Dec]
isUnitFuns      <- [Quantity] -> Q [Dec]
generateIsUnitFuns [Quantity]
unitGroups

  [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ [Dec
dataDec, Dec
showInstance, Dec
fromStringSig, Dec
fromStringFunction, Dec
convertBaseSig, Dec
convertBaseFunc, Dec
convertToSig, Dec
convertToFunc] [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++ [Dec]
isUnitFuns [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++ [Dec]
mkUnitFuns

generateIsUnitFuns :: [Quantity] -> Q [Dec]
generateIsUnitFuns :: [Quantity] -> Q [Dec]
generateIsUnitFuns [Quantity]
unitGroups = [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnitDef -> Q [Dec]) -> [UnitDef] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM UnitDef -> Q [Dec]
mkIsUnitFun ((Quantity -> [UnitDef]) -> [Quantity] -> [UnitDef]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Quantity UnitDef
b [UnitDef]
us) -> UnitDef
bUnitDef -> [UnitDef] -> [UnitDef]
forall a. a -> [a] -> [a]
:[UnitDef]
us) [Quantity]
unitGroups)

mkIsUnitFun :: UnitDef -> Q [Dec]
mkIsUnitFun :: UnitDef -> Q [Dec]
mkIsUnitFun (UnitDef String
u String
_ Double
_) = do
    let funName :: Name
funName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"is" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
u
        pattern :: Pat
pattern = Name -> Cxt -> [Pat] -> Pat
ConP (String -> Name
mkName String
u) [] []
        body :: Body
body    = Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'True
        def :: Clause
def     = [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
pattern] Body
body []
        body' :: Body
body'   = Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'False
        def' :: Clause
def'    = [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
WildP] Body
body' []
    Dec
sig <- Name -> Q Kind -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Kind -> m Dec
sigD Name
funName [t|$(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
unitADT) -> Bool|]
    [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [Dec
sig, Name -> [Clause] -> Dec
FunD Name
funName [Clause
def, Clause
def']]

generateMkUnitFuns :: [Quantity] -> Q [Dec]
generateMkUnitFuns :: [Quantity] -> Q [Dec]
generateMkUnitFuns [Quantity]
unitGroups = [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Dec]] -> [Dec]) -> Q [[Dec]] -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnitDef -> Q [Dec]) -> [UnitDef] -> Q [[Dec]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM UnitDef -> Q [Dec]
mkMkUnitFun ((Quantity -> [UnitDef]) -> [Quantity] -> [UnitDef]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Quantity UnitDef
b [UnitDef]
us) -> UnitDef
bUnitDef -> [UnitDef] -> [UnitDef]
forall a. a -> [a] -> [a]
:[UnitDef]
us) [Quantity]
unitGroups)

mkMkUnitFun :: UnitDef -> Q [Dec]
mkMkUnitFun :: UnitDef -> Q [Dec]
mkMkUnitFun (UnitDef String
u String
_ Double
_) = do
    let funName :: Name
funName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
u
        pattern :: Pat
pattern = Name -> Pat
VarP (Name -> Pat) -> Name -> Pat
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"e"
    Body
body <- Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [|[UnitExp $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
u) e]|]
    Dec
sig  <- Name -> Q Kind -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Kind -> m Dec
sigD Name
funName [t|Int -> [$(Name -> Q Kind
forall (m :: * -> *). Quote m => Name -> m Kind
conT Name
unitExpADT)]|]
    [Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [Dec
sig, Name -> [Clause] -> Dec
FunD Name
funName [[Pat] -> Body -> [Dec] -> Clause
Clause [Pat
pattern] Body
body []]]

mkConvertBaseClaus :: UnitDef -> UnitDef -> Q Clause
mkConvertBaseClaus :: UnitDef -> UnitDef -> Q Clause
mkConvertBaseClaus (UnitDef String
baseUnit String
_ Double
_) (UnitDef String
u String
_ Double
f) = do
    let pattern :: Pat
pattern = Name -> Cxt -> [Pat] -> Pat
ConP 'Value [] [Name -> Pat
VarP (String -> Name
mkName String
"v"), Name -> Cxt -> [Pat] -> Pat
ConP Name
unitExpADT [] [Name -> Cxt -> [Pat] -> Pat
ConP (String -> Name
mkName String
u) [] [], Name -> Pat
VarP (String -> Name
mkName String
"e")]]
    Body
body <- Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [|Value (v * ($(Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> Q Exp) -> Lit -> Q Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Lit
RationalL (Rational -> Lit) -> Rational -> Lit
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
f) ** fromIntegral e)) (UnitExp $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
baseUnit) e)|]
    Clause -> Q Clause
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
pattern] Body
body []

mkConvertToClaus :: UnitDef -> UnitDef -> Q Clause
mkConvertToClaus :: UnitDef -> UnitDef -> Q Clause
mkConvertToClaus (UnitDef String
baseUnit String
_ Double
_) (UnitDef String
u String
_ Double
f) = do
    let patVal :: Pat
patVal  = Name -> Cxt -> [Pat] -> Pat
ConP 'Value [] [Name -> Pat
VarP (String -> Name
mkName String
"v"), Name -> Cxt -> [Pat] -> Pat
ConP Name
unitExpADT [] [Name -> Cxt -> [Pat] -> Pat
ConP (String -> Name
mkName String
baseUnit) [] [], Name -> Pat
VarP (String -> Name
mkName String
"es")]]
        patUnit :: Pat
patUnit = Name -> Cxt -> [Pat] -> Pat
ConP Name
unitExpADT [] [Name -> Cxt -> [Pat] -> Pat
ConP (String -> Name
mkName String
u) [] [], Name -> Pat
VarP (Name -> Pat) -> Name -> Pat
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"et"]
    Guard
checkExpG <- Q Exp -> Q Guard
forall (m :: * -> *). Quote m => m Exp -> m Guard
normalG [|es == et|]
    Guard
elseG     <- Q Exp -> Q Guard
forall (m :: * -> *). Quote m => m Exp -> m Guard
normalG [|otherwise|]
    Exp
thenExp   <- [|Just $ Value (v / ($(Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> Q Exp) -> Lit -> Q Exp
forall a b. (a -> b) -> a -> b
$ Rational -> Lit
RationalL (Rational -> Lit) -> Rational -> Lit
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
f) ** fromIntegral es)) (UnitExp $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
u) es)|]
    Exp
elseExp   <- [|Nothing|]
    let body :: Body
body = [(Guard, Exp)] -> Body
GuardedB [(Guard
checkExpG, Exp
thenExp), (Guard
elseG, Exp
elseExp)]
    Clause -> Q Clause
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return (Clause -> Q Clause) -> Clause -> Q Clause
forall a b. (a -> b) -> a -> b
$ [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
patVal, Pat
patUnit] Body
body []

mkConstructor :: UnitDef -> Con
mkConstructor :: UnitDef -> Con
mkConstructor (UnitDef String
n String
_ Double
_) = Name -> [BangType] -> Con
NormalC (String -> Name
mkName String
n) []

mkShowClause :: UnitDef -> Clause
mkShowClause :: UnitDef -> Clause
mkShowClause (UnitDef String
n String
a Double
_) =
  let pattern :: Pat
pattern = Name -> Cxt -> [Pat] -> Pat
ConP (String -> Name
mkName String
n) [] []
      body :: Body
body    = Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Lit -> Exp
LitE (Lit -> Exp) -> Lit -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
a
  in [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
pattern] Body
body []

mkFromStringClause :: UnitDef -> Clause
mkFromStringClause :: UnitDef -> Clause
mkFromStringClause (UnitDef String
n String
a Double
_) =
  let pattern :: Pat
pattern = Lit -> Pat
LitP (Lit -> Pat) -> Lit -> Pat
forall a b. (a -> b) -> a -> b
$ String -> Lit
StringL String
a
      body :: Body
body    = Exp -> Body
NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Exp -> Exp -> Exp
AppE (Name -> Exp
ConE 'Right) (Name -> Exp
ConE (Name -> Exp) -> Name -> Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
n)
  in [Pat] -> Body -> [Dec] -> Clause
Clause [Pat
pattern] Body
body []