    {-# LANGUAGE CPP #-}
    {-# LANGUAGE TemplateHaskell #-}

    -- | Internal functions to generate CSS size wrapper types.
    module Text.MkSizeType (mkSizeType) where

    #if !MIN_VERSION_template_haskell(2,12,0)
    import Language.Haskell.TH (conT)
    #endif
    import Language.Haskell.TH.Syntax
    import Data.Text.Lazy.Builder (fromLazyText)
    import qualified Data.Text.Lazy as TL

    mkSizeType :: String -> String -> Q [Dec]
    mkSizeType :: String -> String -> Q [Dec]
    mkSizeType String
    name' String
    unit = do
        ddn <- Name -> Q Dec
    dataDec Name
    name
        return  [ ddn
                , showInstanceDec name unit
                , numInstanceDec name
                , fractionalInstanceDec name
                , toCssInstanceDec name ]
      where name :: Name
    name = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    name'

    dataDec :: Name -> Q Dec
    dataDec :: Name -> Q Dec
    dataDec Name
    name =
    #if MIN_VERSION_template_haskell(2,12,0)
      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
    $
        Cxt
    -> Name
    -> [TyVarBndr BndrVis]
    -> Maybe Kind
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataD [] Name
    name [] Maybe Kind
    forall a. Maybe a
    Nothing [Con
    constructor] [Maybe DerivStrategy -> Cxt -> DerivClause
    DerivClause Maybe DerivStrategy
    forall a. Maybe a
    Nothing ((Name -> Kind) -> [Name] -> Cxt
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Kind
    ConT [Name]
    derives)]
    #else
      DataD [] name [] Nothing [constructor] <$> mapM conT derives
    #endif
      where constructor :: Con
    constructor = Name -> [BangType] -> Con
    NormalC Name
    name [(Bang
    notStrict, Name -> Kind
    ConT (Name -> Kind) -> Name -> Kind
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    mkName String
    "Rational")]
            derives :: [Name]
    derives = (String -> Name) -> [String] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Name
    mkName [String
    "Eq", String
    "Ord"]

    showInstanceDec :: Name -> String -> Dec
    showInstanceDec :: Name -> String -> Dec
    showInstanceDec Name
    name String
    unit' = Cxt -> Kind -> [Dec] -> Dec
    instanceD [] (String -> Name -> Kind
    instanceType String
    "Show" Name
    name) [Dec
    showDec]
      where showSize :: Exp
    showSize = Name -> Exp
    VarE (Name -> Exp) -> Name -> Exp
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    mkName String
    "showSize"
            x :: Name
    x = String -> Name
    mkName String
    "x"
            unit :: Exp
    unit = Lit -> Exp
    LitE (Lit -> Exp) -> Lit -> Exp
    forall a b. (a -> b) -> a -> b
    $ String -> Lit
    StringL String
    unit'
            showDec :: Dec
    showDec = Name -> [Clause] -> Dec
    FunD (String -> Name
    mkName String
    "show") [[Pat] -> Body -> [Dec] -> Clause
    Clause [Pat
    showPat] Body
    showBody []]
            showPat :: Pat
    showPat = Name -> [Pat] -> Pat
    conP Name
    name [Name -> Pat
    VarP Name
    x]
            showBody :: Body
    showBody = Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Exp -> Exp -> Exp
    AppE Exp
    showSize (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    x) Exp
    unit

    numInstanceDec :: Name -> Dec
    numInstanceDec :: Name -> Dec
    numInstanceDec Name
    name = Cxt -> Kind -> [Dec] -> Dec
    instanceD [] (String -> Name -> Kind
    instanceType String
    "Num" Name
    name) [Dec]
    decs
      where decs :: [Dec]
    decs = (String -> Dec) -> [String] -> [Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> String -> Dec
    binaryFunDec Name
    name) [String
    "+", String
    "*", String
    "-"] [Dec] -> [Dec] -> [Dec]
    forall a. [a] -> [a] -> [a]
    ++
                   (String -> Dec) -> [String] -> [Dec]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> String -> Dec
    unariFunDec1 Name
    name) [String
    "abs", String
    "signum"] [Dec] -> [Dec] -> [Dec]
    forall a. [a] -> [a] -> [a]
    ++
                   [Name -> String -> Dec
    unariFunDec2 Name
    name String
    "fromInteger"]

    fractionalInstanceDec :: Name -> Dec
    fractionalInstanceDec :: Name -> Dec
    fractionalInstanceDec Name
    name = Cxt -> Kind -> [Dec] -> Dec
    instanceD [] (String -> Name -> Kind
    instanceType String
    "Fractional" Name
    name) [Dec]
    decs
      where decs :: [Dec]
    decs = [Name -> String -> Dec
    binaryFunDec Name
    name String
    "/", Name -> String -> Dec
    unariFunDec2 Name
    name String
    "fromRational"]

    toCssInstanceDec :: Name -> Dec
    toCssInstanceDec :: Name -> Dec
    toCssInstanceDec Name
    name = Cxt -> Kind -> [Dec] -> Dec
    instanceD [] (String -> Name -> Kind
    instanceType String
    "ToCss" Name
    name) [Dec
    toCssDec]
      where toCssDec :: Dec
    toCssDec = Name -> [Clause] -> Dec
    FunD (String -> Name
    mkName String
    "toCss") [[Pat] -> Body -> [Dec] -> Clause
    Clause [] Body
    showBody []]
            showBody :: Body
    showBody = Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ (Exp -> Exp -> Exp
    AppE Exp
    dot Exp
    from) Exp -> Exp -> Exp
    `AppE` ((Exp -> Exp -> Exp
    AppE Exp
    dot Exp
    pack) Exp -> Exp -> Exp
    `AppE` Exp
    show')
            from :: Exp
    from = Name -> Exp
    VarE 'fromLazyText
            pack :: Exp
    pack = Name -> Exp
    VarE 'TL.pack
            dot :: Exp
    dot = Name -> Exp
    VarE 'Prelude.fmap
            show' :: Exp
    show' = Name -> Exp
    VarE 'Prelude.show

    instanceType :: String -> Name -> Type
    instanceType :: String -> Name -> Kind
    instanceType String
    className Name
    name = Kind -> Kind -> Kind
    AppT (Name -> Kind
    ConT (Name -> Kind) -> Name -> Kind
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    mkName String
    className) (Name -> Kind
    ConT Name
    name)

    binaryFunDec :: Name -> String -> Dec
    binaryFunDec :: Name -> String -> Dec
    binaryFunDec Name
    name String
    fun' = Name -> [Clause] -> Dec
    FunD Name
    fun [[Pat] -> Body -> [Dec] -> Clause
    Clause [Pat
    pat1, Pat
    pat2] Body
    body []]
      where pat1 :: Pat
    pat1 = Name -> [Pat] -> Pat
    conP Name
    name [Name -> Pat
    VarP Name
    v1]
            pat2 :: Pat
    pat2 = Name -> [Pat] -> Pat
    conP Name
    name [Name -> Pat
    VarP Name
    v2]
            body :: Body
    body = Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Name -> Exp
    ConE Name
    name) Exp
    result
            result :: Exp
    result = Exp -> Exp -> Exp
    AppE (Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE Name
    fun) (Name -> Exp
    VarE Name
    v1)) (Name -> Exp
    VarE Name
    v2)
            fun :: Name
    fun = String -> Name
    mkName String
    fun'
            v1 :: Name
    v1 = String -> Name
    mkName String
    "v1"
            v2 :: Name
    v2 = String -> Name
    mkName String
    "v2"

    unariFunDec1 :: Name -> String -> Dec
    unariFunDec1 :: Name -> String -> Dec
    unariFunDec1 Name
    name String
    fun' = Name -> [Clause] -> Dec
    FunD Name
    fun [[Pat] -> Body -> [Dec] -> Clause
    Clause [Pat
    pat] Body
    body []]
      where pat :: Pat
    pat = Name -> [Pat] -> Pat
    conP Name
    name [Name -> Pat
    VarP Name
    v]
            body :: Body
    body = Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Name -> Exp
    ConE Name
    name) (Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE Name
    fun) (Name -> Exp
    VarE Name
    v))
            fun :: Name
    fun = String -> Name
    mkName String
    fun'
            v :: Name
    v = String -> Name
    mkName String
    "v"

    unariFunDec2 :: Name -> String -> Dec
    unariFunDec2 :: Name -> String -> Dec
    unariFunDec2 Name
    name String
    fun' = Name -> [Clause] -> Dec
    FunD Name
    fun [[Pat] -> Body -> [Dec] -> Clause
    Clause [Pat
    pat] Body
    body []]
      where pat :: Pat
    pat = Name -> Pat
    VarP Name
    x
            body :: Body
    body = Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Name -> Exp
    ConE Name
    name) (Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE Name
    fun) (Name -> Exp
    VarE Name
    x))
            fun :: Name
    fun = String -> Name
    mkName String
    fun'
            x :: Name
    x = String -> Name
    mkName String
    "x"

    notStrict :: Bang
    notStrict :: Bang
    notStrict = SourceUnpackedness -> SourceStrictness -> Bang
    Bang SourceUnpackedness
    NoSourceUnpackedness SourceStrictness
    NoSourceStrictness

    instanceD :: Cxt -> Type -> [Dec] -> Dec
    instanceD :: Cxt -> Kind -> [Dec] -> Dec
    instanceD = Maybe Overlap -> Cxt -> Kind -> [Dec] -> Dec
    InstanceD Maybe Overlap
    forall a. Maybe a
    Nothing

    conP :: Name -> [Pat] -> Pat
    #if MIN_VERSION_template_haskell(2,18,0)
    conP :: Name -> [Pat] -> Pat
    conP Name
    name = Name -> Cxt -> [Pat] -> Pat
    ConP Name
    name []
    #else
    conP = ConP
    #endif