    {- Data/Singletons/Util.hs

    (c) Richard Eisenberg 2013
    rae@cs.brynmawr.edu

    This file contains helper functions internal to the singletons package.
    Users of the package should not need to consult this file.
    -}

    {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, RankNTypes,
                 TemplateHaskell, GeneralizedNewtypeDeriving,
                 MultiParamTypeClasses, UndecidableInstances, MagicHash,
                 LambdaCase, NoMonomorphismRestriction #-}

    module Data.Singletons.Util where

    import Prelude hiding ( exp, foldl, concat, mapM, any, pred )
    import Language.Haskell.TH.Syntax hiding ( lift )
    import Language.Haskell.TH.Desugar
    import Data.Char
    import Control.Monad hiding ( mapM )
    import Control.Monad.Writer hiding ( mapM )
    import Control.Monad.Reader hiding ( mapM )
    import qualified Data.Map as Map
    import Data.List.NonEmpty (NonEmpty(..))
    import Data.Map ( Map )
    import qualified Data.Monoid as Monoid
    import Data.Semigroup as Semigroup
    import Data.Foldable
    import Data.Functor.Identity
    import Data.Traversable
    import Data.Generics
    import Data.Maybe
    import Data.Void

    -- The list of types that singletons processes by default
    basicTypes :: [Name]
    basicTypes :: [Name]
    basicTypes = [ ''Maybe
                 , ''[]
                 , ''Either
                 , ''NonEmpty
                 , ''Void
                 ] [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ [Name]
    boundedBasicTypes

    boundedBasicTypes :: [Name]
    boundedBasicTypes :: [Name]
    boundedBasicTypes =
                [ ''(,)
                , ''(,,)
                , ''(,,,)
                , ''(,,,,)
                , ''(,,,,,)
                , ''(,,,,,,)
                , ''Identity
                ] [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ [Name]
    enumBasicTypes

    enumBasicTypes :: [Name]
    enumBasicTypes :: [Name]
    enumBasicTypes = [ ''Bool, ''Ordering, ''() ]

    semigroupBasicTypes :: [Name]
    semigroupBasicTypes :: [Name]
    semigroupBasicTypes
      = [ ''Dual
        , ''All
        , ''Any
        , ''Sum
        , ''Product
        -- , ''Endo      see https://github.com/goldfirere/singletons/issues/82
        {- , ''Alt       singletons doesn't support higher kinds :(
                         see https://github.com/goldfirere/singletons/issues/150
        -}

        , ''Min
        , ''Max
        , ''Semigroup.First
        , ''Semigroup.Last
        , ''WrappedMonoid
        ]

    monoidBasicTypes :: [Name]
    monoidBasicTypes :: [Name]
    monoidBasicTypes
      = [ ''Monoid.First
        , ''Monoid.Last
        ]

    -- like reportWarning, but generalized to any Quasi
    qReportWarning :: Quasi q => String -> q ()
    qReportWarning :: String -> q ()
    qReportWarning = Bool -> String -> q ()
    forall (m :: * -> *). Quasi m => Bool -> String -> m ()
    qReport Bool
    False

    -- like reportError, but generalized to any Quasi
    qReportError :: Quasi q => String -> q ()
    qReportError :: String -> q ()
    qReportError = Bool -> String -> q ()
    forall (m :: * -> *). Quasi m => Bool -> String -> m ()
    qReport Bool
    True

    -- | Generate a new Unique
    qNewUnique :: DsMonad q => q Uniq
    qNewUnique :: q Uniq
    qNewUnique = do
      Name _ flav :: NameFlavour
    flav <- String -> q Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "x"
      case NameFlavour
    flav of
        NameU n :: Uniq
    n -> Uniq -> q Uniq
    forall (m :: * -> *) a. Monad m => a -> m a
    return Uniq
    n
        _       -> String -> q Uniq
    forall a. HasCallStack => String -> a
    error "Internal error: `qNewName` didn't return a NameU"

    checkForRep :: Quasi q => [Name] -> q ()
    checkForRep :: [Name] -> q ()
    checkForRep names :: [Name]
    names =
      Bool -> q () -> q ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Name -> Bool) -> [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "Rep") (String -> Bool) -> (Name -> String) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> String
    nameBase) [Name]
    names)
        (String -> q ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q ()) -> String -> q ()
    forall a b. (a -> b) -> a -> b
    $ "A data type named <<Rep>> is a special case.\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                "Promoting it will not work as expected.\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                "Please choose another name for your data type.")

    checkForRepInDecls :: Quasi q => [DDec] -> q ()
    checkForRepInDecls :: [DDec] -> q ()
    checkForRepInDecls decls :: [DDec]
    decls =
      [Name] -> q ()
    forall (q :: * -> *). Quasi q => [Name] -> q ()
    checkForRep ([DDec] -> [Name]
    forall a. Data a => a -> [Name]
    allNamesIn [DDec]
    decls)

    tysOfConFields :: DConFields -> [DType]
    tysOfConFields :: DConFields -> [DType]
    tysOfConFields (DNormalC _ stys :: [DBangType]
    stys) = (DBangType -> DType) -> [DBangType] -> [DType]
    forall a b. (a -> b) -> [a] -> [b]
    map DBangType -> DType
    forall a b. (a, b) -> b
    snd [DBangType]
    stys
    tysOfConFields (DRecC vstys :: [DVarBangType]
    vstys)   = (DVarBangType -> DType) -> [DVarBangType] -> [DType]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(_,_,ty :: DType
    ty) -> DType
    ty) [DVarBangType]
    vstys

    -- extract the name and number of arguments to a constructor
    extractNameArgs :: DCon -> (Name, Int)
    extractNameArgs :: DCon -> (Name, Uniq)
    extractNameArgs = ([DType] -> Uniq) -> (Name, [DType]) -> (Name, Uniq)
    forall a b c. (a -> b) -> (c, a) -> (c, b)
    liftSnd [DType] -> Uniq
    forall (t :: * -> *) a. Foldable t => t a -> Uniq
    length ((Name, [DType]) -> (Name, Uniq))
    -> (DCon -> (Name, [DType])) -> DCon -> (Name, Uniq)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DCon -> (Name, [DType])
    extractNameTypes

    -- extract the name and types of constructor arguments
    extractNameTypes :: DCon -> (Name, [DType])
    extractNameTypes :: DCon -> (Name, [DType])
    extractNameTypes (DCon _ _ n :: Name
    n fields :: DConFields
    fields _) = (Name
    n, DConFields -> [DType]
    tysOfConFields DConFields
    fields)

    extractName :: DCon -> Name
    extractName :: DCon -> Name
    extractName (DCon _ _ n :: Name
    n _ _) = Name
    n

    -- | is a valid Haskell infix data constructor (i.e., does it begin with a colon?)
    isInfixDataCon :: String -> Bool
    isInfixDataCon :: String -> Bool
    isInfixDataCon (':':_) = Bool
    True
    isInfixDataCon _       = Bool
    False

    -- | Is an identifier a legal data constructor name in Haskell? That is, is its
    -- first character an uppercase letter (prefix) or a colon (infix)?
    isDataConName :: Name -> Bool
    isDataConName :: Name -> Bool
    isDataConName n :: Name
    n = let first :: Char
    first = String -> Char
    forall a. [a] -> a
    head (Name -> String
    nameBase Name
    n) in Char -> Bool
    isUpper Char
    first Bool -> Bool -> Bool
    || Char
    first Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ':'

    -- | Is an identifier uppercase?
    --
    -- Note that this will always return 'False' for infix names, since the concept
    -- of upper- and lower-case doesn't make sense for non-alphabetic characters.
    -- If you want to check if a name is legal as a data constructor, use the
    -- 'isDataConName' function.
    isUpcase :: Name -> Bool
    isUpcase :: Name -> Bool
    isUpcase n :: Name
    n = let first :: Char
    first = String -> Char
    forall a. [a] -> a
    head (Name -> String
    nameBase Name
    n) in Char -> Bool
    isUpper Char
    first

    -- Make an identifier uppercase. If the identifier is infix, this acts as the
    -- identity function.
    upcase :: Name -> Name
    upcase :: Name -> Name
    upcase = String -> Name
    mkName (String -> Name) -> (Name -> String) -> Name -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, String) -> Name -> String
    toUpcaseStr (String, String)
    noPrefix

    -- make an identifier uppercase and return it as a String
    toUpcaseStr :: (String, String)  -- (alpha, symb) prefixes to prepend
                -> Name -> String
    toUpcaseStr :: (String, String) -> Name -> String
    toUpcaseStr (alpha :: String
    alpha, symb :: String
    symb) n :: Name
    n
      | Char -> Bool
    isHsLetter Char
    first
      = String
    upcase_alpha

      | Bool
    otherwise
      = String
    upcase_symb

      where
        str :: String
    str   = Name -> String
    nameBase Name
    n
        first :: Char
    first = String -> Char
    forall a. [a] -> a
    head String
    str

        upcase_alpha :: String
    upcase_alpha = String
    alpha String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char -> Char
    toUpper Char
    first) Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    forall a. [a] -> [a]
    tail String
    str
        upcase_symb :: String
    upcase_symb = String
    symb String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str

    noPrefix :: (String, String)
    noPrefix :: (String, String)
    noPrefix = ("", "")

    -- Put an uppercase prefix on a constructor name. Takes two prefixes:
    -- one for identifiers and one for symbols.
    --
    -- This is different from 'prefixName' in that infix constructor names always
    -- start with a colon, so we must insert the prefix after the colon in order
    -- for the new name to be syntactically valid.
    prefixConName :: String -> String -> Name -> Name
    prefixConName :: String -> String -> Name -> Name
    prefixConName pre :: String
    pre tyPre :: String
    tyPre n :: Name
    n = case (Name -> String
    nameBase Name
    n) of
        (':' : rest :: String
    rest) -> String -> Name
    mkName (':' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    tyPre String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    rest)
        alpha :: String
    alpha -> String -> Name
    mkName (String
    pre String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    alpha)

    -- Put a prefix on a name. Takes two prefixes: one for identifiers
    -- and one for symbols.
    prefixName :: String -> String -> Name -> Name
    prefixName :: String -> String -> Name -> Name
    prefixName pre :: String
    pre tyPre :: String
    tyPre n :: Name
    n =
      let str :: String
    str = Name -> String
    nameBase Name
    n
          first :: Char
    first = String -> Char
    forall a. [a] -> a
    head String
    str in
        if Char -> Bool
    isHsLetter Char
    first
         then String -> Name
    mkName (String
    pre String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str)
         else String -> Name
    mkName (String
    tyPre String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    str)

    -- Put a suffix on a name. Takes two suffixes: one for identifiers
    -- and one for symbols.
    suffixName :: String -> String -> Name -> Name
    suffixName :: String -> String -> Name -> Name
    suffixName ident :: String
    ident symb :: String
    symb n :: Name
    n =
      let str :: String
    str = Name -> String
    nameBase Name
    n
          first :: Char
    first = String -> Char
    forall a. [a] -> a
    head String
    str in
      if Char -> Bool
    isHsLetter Char
    first
      then String -> Name
    mkName (String
    str String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ident)
      else String -> Name
    mkName (String
    str String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    symb)

    -- convert a number into both alphanumeric and symoblic forms
    uniquePrefixes :: String   -- alphanumeric prefix
                   -> String   -- symbolic prefix
                   -> Uniq
                   -> (String, String)  -- (alphanum, symbolic)
    uniquePrefixes :: String -> String -> Uniq -> (String, String)
    uniquePrefixes alpha :: String
    alpha symb :: String
    symb n :: Uniq
    n = (String
    alpha String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    n_str, String
    symb String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    convert String
    n_str)
      where
        n_str :: String
    n_str = Uniq -> String
    forall a. Show a => a -> String
    show Uniq
    n

        convert :: String -> String
    convert [] = []
        convert (d :: Char
    d : ds :: String
    ds) =
          let d' :: Char
    d' = case Char
    d of
                     '0' -> '!'
                     '1' -> '#'
                     '2' -> '$'
                     '3' -> '%'
                     '4' -> '&'
                     '5' -> '*'
                     '6' -> '+'
                     '7' -> '.'
                     '8' -> '/'
                     '9' -> '>'
                     _   -> String -> Char
    forall a. HasCallStack => String -> a
    error "non-digit in show #"
          in Char
    d' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String -> String
    convert String
    ds

    -- extract the kind from a TyVarBndr
    extractTvbKind :: DTyVarBndr -> Maybe DKind
    extractTvbKind :: DTyVarBndr -> Maybe DType
    extractTvbKind (DPlainTV _) = Maybe DType
    forall a. Maybe a
    Nothing
    extractTvbKind (DKindedTV _ k :: DType
    k) = DType -> Maybe DType
    forall a. a -> Maybe a
    Just DType
    k

    -- extract the name from a TyVarBndr.
    extractTvbName :: DTyVarBndr -> Name
    extractTvbName :: DTyVarBndr -> Name
    extractTvbName (DPlainTV n :: Name
    n) = Name
    n
    extractTvbName (DKindedTV n :: Name
    n _) = Name
    n

    tvbToType :: DTyVarBndr -> DType
    tvbToType :: DTyVarBndr -> DType
    tvbToType = Name -> DType
    DVarT (Name -> DType) -> (DTyVarBndr -> Name) -> DTyVarBndr -> DType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DTyVarBndr -> Name
    extractTvbName

    inferMaybeKindTV :: Name -> Maybe DKind -> DTyVarBndr
    inferMaybeKindTV :: Name -> Maybe DType -> DTyVarBndr
    inferMaybeKindTV n :: Name
    n Nothing =  Name -> DTyVarBndr
    DPlainTV Name
    n
    inferMaybeKindTV n :: Name
    n (Just k :: DType
    k) = Name -> DType -> DTyVarBndr
    DKindedTV Name
    n DType
    k

    resultSigToMaybeKind :: DFamilyResultSig -> Maybe DKind
    resultSigToMaybeKind :: DFamilyResultSig -> Maybe DType
    resultSigToMaybeKind DNoSig                      = Maybe DType
    forall a. Maybe a
    Nothing
    resultSigToMaybeKind (DKindSig k :: DType
    k)                = DType -> Maybe DType
    forall a. a -> Maybe a
    Just DType
    k
    resultSigToMaybeKind (DTyVarSig (DPlainTV _))    = Maybe DType
    forall a. Maybe a
    Nothing
    resultSigToMaybeKind (DTyVarSig (DKindedTV _ k :: DType
    k)) = DType -> Maybe DType
    forall a. a -> Maybe a
    Just DType
    k

    -- Reconstruct arrow kind from the list of kinds
    ravel :: [DType] -> DType -> DType
    ravel :: [DType] -> DType -> DType
    ravel []    res :: DType
    res  = DType
    res
    ravel (h :: DType
    h:t :: [DType]
    t) res :: DType
    res = DType -> DType -> DType
    DAppT (DType -> DType -> DType
    DAppT DType
    DArrowT DType
    h) ([DType] -> DType -> DType
    ravel [DType]
    t DType
    res)

    -- count the number of arguments in a type
    countArgs :: DType -> Int
    countArgs :: DType -> Uniq
    countArgs ty :: DType
    ty = [DType] -> Uniq
    forall (t :: * -> *) a. Foldable t => t a -> Uniq
    length [DType]
    args
      where (_, _, args :: [DType]
    args, _) = DType -> ([DTyVarBndr], [DType], [DType], DType)
    unravel DType
    ty

    -- changes all TyVars not to be NameU's. Workaround for GHC#11812
    noExactTyVars :: Data a => a -> a
    noExactTyVars :: a -> a
    noExactTyVars = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
    everywhere forall a. Data a => a -> a
    go
      where
        go :: Data a => a -> a
        go :: a -> a
    go = (DTyVarBndr -> DTyVarBndr) -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT DTyVarBndr -> DTyVarBndr
    fix_tvb (a -> a) -> (DType -> DType) -> a -> a
    forall a b.
    (Typeable a, Typeable b) =>
    (a -> a) -> (b -> b) -> a -> a
    `extT` DType -> DType
    fix_ty (a -> a) -> (InjectivityAnn -> InjectivityAnn) -> a -> a
    forall a b.
    (Typeable a, Typeable b) =>
    (a -> a) -> (b -> b) -> a -> a
    `extT` InjectivityAnn -> InjectivityAnn
    fix_inj_ann

        no_exact_name :: Name -> Name
        no_exact_name :: Name -> Name
    no_exact_name (Name (OccName occ :: String
    occ) (NameU unique :: Uniq
    unique)) = String -> Name
    mkName (String
    occ String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Uniq -> String
    forall a. Show a => a -> String
    show Uniq
    unique)
        no_exact_name n :: Name
    n                                   = Name
    n

        fix_tvb :: DTyVarBndr -> DTyVarBndr
    fix_tvb (DPlainTV n :: Name
    n)    = Name -> DTyVarBndr
    DPlainTV (Name -> Name
    no_exact_name Name
    n)
        fix_tvb (DKindedTV n :: Name
    n k :: DType
    k) = Name -> DType -> DTyVarBndr
    DKindedTV (Name -> Name
    no_exact_name Name
    n) DType
    k

        fix_ty :: DType -> DType
    fix_ty (DVarT n :: Name
    n)           = Name -> DType
    DVarT (Name -> Name
    no_exact_name Name
    n)
        fix_ty ty :: DType
    ty                  = DType
    ty

        fix_inj_ann :: InjectivityAnn -> InjectivityAnn
    fix_inj_ann (InjectivityAnn lhs :: Name
    lhs rhs :: [Name]
    rhs)
          = Name -> [Name] -> InjectivityAnn
    InjectivityAnn (Name -> Name
    no_exact_name Name
    lhs) ((Name -> Name) -> [Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Name
    no_exact_name [Name]
    rhs)

    substKind :: Map Name DKind -> DKind -> DKind
    substKind :: Map Name DType -> DType -> DType
    substKind = Map Name DType -> DType -> DType
    substType

    -- | Non–capture-avoiding substitution. (If you want capture-avoiding
    -- substitution, use @substTy@ from "Language.Haskell.TH.Desugar.Subst".
    substType :: Map Name DType -> DType -> DType
    substType :: Map Name DType -> DType -> DType
    substType subst :: Map Name DType
    subst ty :: DType
    ty | Map Name DType -> Bool
    forall k a. Map k a -> Bool
    Map.null Map Name DType
    subst = DType
    ty
    substType subst :: Map Name DType
    subst (DForallT tvbs :: [DTyVarBndr]
    tvbs cxt :: [DType]
    cxt inner_ty :: DType
    inner_ty)
      = [DTyVarBndr] -> [DType] -> DType -> DType
    DForallT [DTyVarBndr]
    tvbs' [DType]
    cxt' DType
    inner_ty'
      where
        (subst' :: Map Name DType
    subst', tvbs' :: [DTyVarBndr]
    tvbs') = (Map Name DType -> DTyVarBndr -> (Map Name DType, DTyVarBndr))
    -> Map Name DType -> [DTyVarBndr] -> (Map Name DType, [DTyVarBndr])
    forall (t :: * -> *) a b c.
    Traversable t =>
    (a -> b -> (a, c)) -> a -> t b -> (a, t c)
    mapAccumL Map Name DType -> DTyVarBndr -> (Map Name DType, DTyVarBndr)
    subst_tvb Map Name DType
    subst [DTyVarBndr]
    tvbs
        cxt' :: [DType]
    cxt'            = (DType -> DType) -> [DType] -> [DType]
    forall a b. (a -> b) -> [a] -> [b]
    map (Map Name DType -> DType -> DType
    substType Map Name DType
    subst') [DType]
    cxt
        inner_ty' :: DType
    inner_ty'       = Map Name DType -> DType -> DType
    substType Map Name DType
    subst' DType
    inner_ty
    substType subst :: Map Name DType
    subst (DAppT ty1 :: DType
    ty1 ty2 :: DType
    ty2) = Map Name DType -> DType -> DType
    substType Map Name DType
    subst DType
    ty1 DType -> DType -> DType
    `DAppT` Map Name DType -> DType -> DType
    substType Map Name DType
    subst DType
    ty2
    substType subst :: Map Name DType
    subst (DAppKindT ty :: DType
    ty ki :: DType
    ki) = Map Name DType -> DType -> DType
    substType Map Name DType
    subst DType
    ty DType -> DType -> DType
    `DAppKindT` Map Name DType -> DType -> DType
    substType Map Name DType
    subst DType
    ki
    substType subst :: Map Name DType
    subst (DSigT ty :: DType
    ty ki :: DType
    ki) = Map Name DType -> DType -> DType
    substType Map Name DType
    subst DType
    ty DType -> DType -> DType
    `DSigT` Map Name DType -> DType -> DType
    substType Map Name DType
    subst DType
    ki
    substType subst :: Map Name DType
    subst (DVarT n :: Name
    n) =
      case Name -> Map Name DType -> Maybe DType
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    n Map Name DType
    subst of
        Just ki :: DType
    ki -> DType
    ki
        Nothing -> Name -> DType
    DVarT Name
    n
    substType _ ty :: DType
    ty@(DConT {}) = DType
    ty
    substType _ ty :: DType
    ty@(DType
    DArrowT)  = DType
    ty
    substType _ ty :: DType
    ty@(DLitT {}) = DType
    ty
    substType _ ty :: DType
    ty@DType
    DWildCardT = DType
    ty

    subst_tvb :: Map Name DKind -> DTyVarBndr -> (Map Name DKind, DTyVarBndr)
    subst_tvb :: Map Name DType -> DTyVarBndr -> (Map Name DType, DTyVarBndr)
    subst_tvb s :: Map Name DType
    s tvb :: DTyVarBndr
    tvb@(DPlainTV n :: Name
    n) = (Name -> Map Name DType -> Map Name DType
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Name
    n Map Name DType
    s, DTyVarBndr
    tvb)
    subst_tvb s :: Map Name DType
    s (DKindedTV n :: Name
    n k :: DType
    k)  = (Name -> Map Name DType -> Map Name DType
    forall k a. Ord k => k -> Map k a -> Map k a
    Map.delete Name
    n Map Name DType
    s, Name -> DType -> DTyVarBndr
    DKindedTV Name
    n (Map Name DType -> DType -> DType
    substKind Map Name DType
    s DType
    k))

    cuskify :: DTyVarBndr -> DTyVarBndr
    cuskify :: DTyVarBndr -> DTyVarBndr
    cuskify (DPlainTV tvname :: Name
    tvname) = Name -> DType -> DTyVarBndr
    DKindedTV Name
    tvname (DType -> DTyVarBndr) -> DType -> DTyVarBndr
    forall a b. (a -> b) -> a -> b
    $ Name -> DType
    DConT Name
    typeKindName
    cuskify tvb :: DTyVarBndr
    tvb               = DTyVarBndr
    tvb

    -- apply a type to a list of types
    foldType :: DType -> [DType] -> DType
    foldType :: DType -> [DType] -> DType
    foldType = (DType -> DType -> DType) -> DType -> [DType] -> DType
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DType -> DType -> DType
    DAppT

    -- apply a type to a list of type variable binders
    foldTypeTvbs :: DType -> [DTyVarBndr] -> DType
    foldTypeTvbs :: DType -> [DTyVarBndr] -> DType
    foldTypeTvbs ty :: DType
    ty = DType -> [DType] -> DType
    foldType DType
    ty ([DType] -> DType)
    -> ([DTyVarBndr] -> [DType]) -> [DTyVarBndr] -> DType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DTyVarBndr -> DType) -> [DTyVarBndr] -> [DType]
    forall a b. (a -> b) -> [a] -> [b]
    map DTyVarBndr -> DType
    tvbToType

    -- Construct a data type's variable binders, possibly using fresh variables
    -- from the data type's kind signature.
    buildDataDTvbs :: DsMonad q => [DTyVarBndr] -> Maybe DKind -> q [DTyVarBndr]
    buildDataDTvbs :: [DTyVarBndr] -> Maybe DType -> q [DTyVarBndr]
    buildDataDTvbs tvbs :: [DTyVarBndr]
    tvbs mk :: Maybe DType
    mk = do
      [DTyVarBndr]
    extra_tvbs <- DType -> q [DTyVarBndr]
    forall (q :: * -> *). DsMonad q => DType -> q [DTyVarBndr]
    mkExtraDKindBinders (DType -> q [DTyVarBndr]) -> DType -> q [DTyVarBndr]
    forall a b. (a -> b) -> a -> b
    $ DType -> Maybe DType -> DType
    forall a. a -> Maybe a -> a
    fromMaybe (Name -> DType
    DConT Name
    typeKindName) Maybe DType
    mk
      [DTyVarBndr] -> q [DTyVarBndr]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([DTyVarBndr] -> q [DTyVarBndr]) -> [DTyVarBndr] -> q [DTyVarBndr]
    forall a b. (a -> b) -> a -> b
    $ [DTyVarBndr]
    tvbs [DTyVarBndr] -> [DTyVarBndr] -> [DTyVarBndr]
    forall a. [a] -> [a] -> [a]
    ++ [DTyVarBndr]
    extra_tvbs

    -- apply an expression to a list of expressions
    foldExp :: DExp -> [DExp] -> DExp
    foldExp :: DExp -> [DExp] -> DExp
    foldExp = (DExp -> DExp -> DExp) -> DExp -> [DExp] -> DExp
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl DExp -> DExp -> DExp
    DAppE

    -- is a function type?
    isFunTy :: DType -> Bool
    isFunTy :: DType -> Bool
    isFunTy (DAppT (DAppT DArrowT _) _) = Bool
    True
    isFunTy (DForallT _ _ _)            = Bool
    True
    isFunTy _                           = Bool
    False

    -- choose the first non-empty list
    orIfEmpty :: [a] -> [a] -> [a]
    orIfEmpty :: [a] -> [a] -> [a]
    orIfEmpty [] x :: [a]
    x = [a]
    x
    orIfEmpty x :: [a]
    x  _ = [a]
    x

    -- build a pattern match over several expressions, each with only one pattern
    multiCase :: [DExp] -> [DPat] -> DExp -> DExp
    multiCase :: [DExp] -> [DPat] -> DExp -> DExp
    multiCase [] [] body :: DExp
    body = DExp
    body
    multiCase scruts :: [DExp]
    scruts pats :: [DPat]
    pats body :: DExp
    body =
      DExp -> [DMatch] -> DExp
    DCaseE ([DExp] -> DExp
    mkTupleDExp [DExp]
    scruts) [DPat -> DExp -> DMatch
    DMatch ([DPat] -> DPat
    mkTupleDPat [DPat]
    pats) DExp
    body]

    -- Make a desugar function into a TH function.
    wrapDesugar :: (Desugar th ds, DsMonad q) => (th -> ds -> q ds) -> th -> q th
    wrapDesugar :: (th -> ds -> q ds) -> th -> q th
    wrapDesugar f :: th -> ds -> q ds
    f th :: th
    th = do
      ds
    ds <- th -> q ds
    forall th ds (q :: * -> *).
    (Desugar th ds, DsMonad q) =>
    th -> q ds
    desugar th
    th
      (ds -> th) -> q ds -> q th
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ds -> th
    forall th ds. Desugar th ds => ds -> th
    sweeten (q ds -> q th) -> q ds -> q th
    forall a b. (a -> b) -> a -> b
    $ th -> ds -> q ds
    f th
    th ds
    ds

    -- a monad transformer for writing a monoid alongside returning a Q
    newtype QWithAux m q a = QWA { QWithAux m q a -> WriterT m q a
    runQWA :: WriterT m q a }
      deriving ( a -> QWithAux m q b -> QWithAux m q a
    (a -> b) -> QWithAux m q a -> QWithAux m q b
    (forall a b. (a -> b) -> QWithAux m q a -> QWithAux m q b)
    -> (forall a b. a -> QWithAux m q b -> QWithAux m q a)
    -> Functor (QWithAux m q)
    forall a b. a -> QWithAux m q b -> QWithAux m q a
    forall a b. (a -> b) -> QWithAux m q a -> QWithAux m q b
    forall m (q :: * -> *) a b.
    Functor q =>
    a -> QWithAux m q b -> QWithAux m q a
    forall m (q :: * -> *) a b.
    Functor q =>
    (a -> b) -> QWithAux m q a -> QWithAux m q b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: a -> QWithAux m q b -> QWithAux m q a
    $c<$ :: forall m (q :: * -> *) a b.
    Functor q =>
    a -> QWithAux m q b -> QWithAux m q a
    fmap :: (a -> b) -> QWithAux m q a -> QWithAux m q b
    $cfmap :: forall m (q :: * -> *) a b.
    Functor q =>
    (a -> b) -> QWithAux m q a -> QWithAux m q b
    Functor, Functor (QWithAux m q)
    a -> QWithAux m q a
    Functor (QWithAux m q) =>
    (forall a. a -> QWithAux m q a)
    -> (forall a b.
        QWithAux m q (a -> b) -> QWithAux m q a -> QWithAux m q b)
    -> (forall a b c.
        (a -> b -> c)
        -> QWithAux m q a -> QWithAux m q b -> QWithAux m q c)
    -> (forall a b. QWithAux m q a -> QWithAux m q b -> QWithAux m q b)
    -> (forall a b. QWithAux m q a -> QWithAux m q b -> QWithAux m q a)
    -> Applicative (QWithAux m q)
    QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    QWithAux m q a -> QWithAux m q b -> QWithAux m q a
    QWithAux m q (a -> b) -> QWithAux m q a -> QWithAux m q b
    (a -> b -> c) -> QWithAux m q a -> QWithAux m q b -> QWithAux m q c
    forall a. a -> QWithAux m q a
    forall a b. QWithAux m q a -> QWithAux m q b -> QWithAux m q a
    forall a b. QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    forall a b.
    QWithAux m q (a -> b) -> QWithAux m q a -> QWithAux m q b
    forall a b c.
    (a -> b -> c) -> QWithAux m q a -> QWithAux m q b -> QWithAux m q c
    forall m (q :: * -> *).
    (Monoid m, Applicative q) =>
    Functor (QWithAux m q)
    forall m (q :: * -> *) a.
    (Monoid m, Applicative q) =>
    a -> QWithAux m q a
    forall m (q :: * -> *) a b.
    (Monoid m, Applicative q) =>
    QWithAux m q a -> QWithAux m q b -> QWithAux m q a
    forall m (q :: * -> *) a b.
    (Monoid m, Applicative q) =>
    QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    forall m (q :: * -> *) a b.
    (Monoid m, Applicative q) =>
    QWithAux m q (a -> b) -> QWithAux m q a -> QWithAux m q b
    forall m (q :: * -> *) a b c.
    (Monoid m, Applicative q) =>
    (a -> b -> c) -> QWithAux m q a -> QWithAux m q b -> QWithAux m q c
    forall (f :: * -> *).
    Functor f =>
    (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    <* :: QWithAux m q a -> QWithAux m q b -> QWithAux m q a
    $c<* :: forall m (q :: * -> *) a b.
    (Monoid m, Applicative q) =>
    QWithAux m q a -> QWithAux m q b -> QWithAux m q a
    *> :: QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    $c*> :: forall m (q :: * -> *) a b.
    (Monoid m, Applicative q) =>
    QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    liftA2 :: (a -> b -> c) -> QWithAux m q a -> QWithAux m q b -> QWithAux m q c
    $cliftA2 :: forall m (q :: * -> *) a b c.
    (Monoid m, Applicative q) =>
    (a -> b -> c) -> QWithAux m q a -> QWithAux m q b -> QWithAux m q c
    <*> :: QWithAux m q (a -> b) -> QWithAux m q a -> QWithAux m q b
    $c<*> :: forall m (q :: * -> *) a b.
    (Monoid m, Applicative q) =>
    QWithAux m q (a -> b) -> QWithAux m q a -> QWithAux m q b
    pure :: a -> QWithAux m q a
    $cpure :: forall m (q :: * -> *) a.
    (Monoid m, Applicative q) =>
    a -> QWithAux m q a
    $cp1Applicative :: forall m (q :: * -> *).
    (Monoid m, Applicative q) =>
    Functor (QWithAux m q)
    Applicative, Applicative (QWithAux m q)
    a -> QWithAux m q a
    Applicative (QWithAux m q) =>
    (forall a b.
     QWithAux m q a -> (a -> QWithAux m q b) -> QWithAux m q b)
    -> (forall a b. QWithAux m q a -> QWithAux m q b -> QWithAux m q b)
    -> (forall a. a -> QWithAux m q a)
    -> Monad (QWithAux m q)
    QWithAux m q a -> (a -> QWithAux m q b) -> QWithAux m q b
    QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    forall a. a -> QWithAux m q a
    forall a b. QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    forall a b.
    QWithAux m q a -> (a -> QWithAux m q b) -> QWithAux m q b
    forall m (q :: * -> *).
    (Monoid m, Monad q) =>
    Applicative (QWithAux m q)
    forall m (q :: * -> *) a.
    (Monoid m, Monad q) =>
    a -> QWithAux m q a
    forall m (q :: * -> *) a b.
    (Monoid m, Monad q) =>
    QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    forall m (q :: * -> *) a b.
    (Monoid m, Monad q) =>
    QWithAux m q a -> (a -> QWithAux m q b) -> QWithAux m q b
    forall (m :: * -> *).
    Applicative m =>
    (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    return :: a -> QWithAux m q a
    $creturn :: forall m (q :: * -> *) a.
    (Monoid m, Monad q) =>
    a -> QWithAux m q a
    >> :: QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    $c>> :: forall m (q :: * -> *) a b.
    (Monoid m, Monad q) =>
    QWithAux m q a -> QWithAux m q b -> QWithAux m q b
    >>= :: QWithAux m q a -> (a -> QWithAux m q b) -> QWithAux m q b
    $c>>= :: forall m (q :: * -> *) a b.
    (Monoid m, Monad q) =>
    QWithAux m q a -> (a -> QWithAux m q b) -> QWithAux m q b
    $cp1Monad :: forall m (q :: * -> *).
    (Monoid m, Monad q) =>
    Applicative (QWithAux m q)
    Monad, m a -> QWithAux m m a
    (forall (m :: * -> *) a. Monad m => m a -> QWithAux m m a)
    -> MonadTrans (QWithAux m)
    forall m (m :: * -> *) a.
    (Monoid m, Monad m) =>
    m a -> QWithAux m m a
    forall (m :: * -> *) a. Monad m => m a -> QWithAux m m a
    forall (t :: (* -> *) -> * -> *).
    (forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
    lift :: m a -> QWithAux m m a
    $clift :: forall m (m :: * -> *) a.
    (Monoid m, Monad m) =>
    m a -> QWithAux m m a
    MonadTrans
               , MonadWriter m, MonadReader r
               , Monad (QWithAux m q)
    Monad (QWithAux m q) =>
    (forall a. String -> QWithAux m q a) -> MonadFail (QWithAux m q)
    String -> QWithAux m q a
    forall a. String -> QWithAux m q a
    forall m (q :: * -> *).
    (Monoid m, MonadFail q) =>
    Monad (QWithAux m q)
    forall m (q :: * -> *) a.
    (Monoid m, MonadFail q) =>
    String -> QWithAux m q a
    forall (m :: * -> *).
    Monad m =>
    (forall a. String -> m a) -> MonadFail m
    fail :: String -> QWithAux m q a
    $cfail :: forall m (q :: * -> *) a.
    (Monoid m, MonadFail q) =>
    String -> QWithAux m q a
    $cp1MonadFail :: forall m (q :: * -> *).
    (Monoid m, MonadFail q) =>
    Monad (QWithAux m q)
    MonadFail, Monad (QWithAux m q)
    Monad (QWithAux m q) =>
    (forall a. IO a -> QWithAux m q a) -> MonadIO (QWithAux m q)
    IO a -> QWithAux m q a
    forall a. IO a -> QWithAux m q a
    forall m (q :: * -> *).
    (Monoid m, MonadIO q) =>
    Monad (QWithAux m q)
    forall m (q :: * -> *) a.
    (Monoid m, MonadIO q) =>
    IO a -> QWithAux m q a
    forall (m :: * -> *).
    Monad m =>
    (forall a. IO a -> m a) -> MonadIO m
    liftIO :: IO a -> QWithAux m q a
    $cliftIO :: forall m (q :: * -> *) a.
    (Monoid m, MonadIO q) =>
    IO a -> QWithAux m q a
    $cp1MonadIO :: forall m (q :: * -> *).
    (Monoid m, MonadIO q) =>
    Monad (QWithAux m q)
    MonadIO )

    -- make a Quasi instance for easy lifting
    instance (Quasi q, Monoid m) => Quasi (QWithAux m q) where
      qNewName :: String -> QWithAux m q Name
    qNewName          = q Name -> QWithAux m q Name
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q Name -> QWithAux m q Name)
    -> (String -> q Name) -> String -> QWithAux m q Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` String -> q Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName
      qReport :: Bool -> String -> QWithAux m q ()
    qReport           = q () -> QWithAux m q ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q () -> QWithAux m q ())
    -> (Bool -> String -> q ()) -> Bool -> String -> QWithAux m q ()
    forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
    `comp2` Bool -> String -> q ()
    forall (m :: * -> *). Quasi m => Bool -> String -> m ()
    qReport
      qLookupName :: Bool -> String -> QWithAux m q (Maybe Name)
    qLookupName       = q (Maybe Name) -> QWithAux m q (Maybe Name)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q (Maybe Name) -> QWithAux m q (Maybe Name))
    -> (Bool -> String -> q (Maybe Name))
    -> Bool
    -> String
    -> QWithAux m q (Maybe Name)
    forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
    `comp2` Bool -> String -> q (Maybe Name)
    forall (m :: * -> *). Quasi m => Bool -> String -> m (Maybe Name)
    qLookupName
      qReify :: Name -> QWithAux m q Info
    qReify            = q Info -> QWithAux m q Info
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q Info -> QWithAux m q Info)
    -> (Name -> q Info) -> Name -> QWithAux m q Info
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` Name -> q Info
    forall (m :: * -> *). Quasi m => Name -> m Info
    qReify
      qReifyInstances :: Name -> [Type] -> QWithAux m q [Dec]
    qReifyInstances   = q [Dec] -> QWithAux m q [Dec]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q [Dec] -> QWithAux m q [Dec])
    -> (Name -> [Type] -> q [Dec])
    -> Name
    -> [Type]
    -> QWithAux m q [Dec]
    forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
    `comp2` Name -> [Type] -> q [Dec]
    forall (m :: * -> *). Quasi m => Name -> [Type] -> m [Dec]
    qReifyInstances
      qLocation :: QWithAux m q Loc
    qLocation         = q Loc -> QWithAux m q Loc
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift q Loc
    forall (m :: * -> *). Quasi m => m Loc
    qLocation
      qRunIO :: IO a -> QWithAux m q a
    qRunIO            = q a -> QWithAux m q a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q a -> QWithAux m q a) -> (IO a -> q a) -> IO a -> QWithAux m q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` IO a -> q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO
      qAddDependentFile :: String -> QWithAux m q ()
    qAddDependentFile = q () -> QWithAux m q ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q () -> QWithAux m q ())
    -> (String -> q ()) -> String -> QWithAux m q ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` String -> q ()
    forall (m :: * -> *). Quasi m => String -> m ()
    qAddDependentFile
      qReifyRoles :: Name -> QWithAux m q [Role]
    qReifyRoles       = q [Role] -> QWithAux m q [Role]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q [Role] -> QWithAux m q [Role])
    -> (Name -> q [Role]) -> Name -> QWithAux m q [Role]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` Name -> q [Role]
    forall (m :: * -> *). Quasi m => Name -> m [Role]
    qReifyRoles
      qReifyAnnotations :: AnnLookup -> QWithAux m q [a]
    qReifyAnnotations = q [a] -> QWithAux m q [a]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q [a] -> QWithAux m q [a])
    -> (AnnLookup -> q [a]) -> AnnLookup -> QWithAux m q [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` AnnLookup -> q [a]
    forall (m :: * -> *) a. (Quasi m, Data a) => AnnLookup -> m [a]
    qReifyAnnotations
      qReifyModule :: Module -> QWithAux m q ModuleInfo
    qReifyModule      = q ModuleInfo -> QWithAux m q ModuleInfo
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q ModuleInfo -> QWithAux m q ModuleInfo)
    -> (Module -> q ModuleInfo) -> Module -> QWithAux m q ModuleInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` Module -> q ModuleInfo
    forall (m :: * -> *). Quasi m => Module -> m ModuleInfo
    qReifyModule
      qAddTopDecls :: [Dec] -> QWithAux m q ()
    qAddTopDecls      = q () -> QWithAux m q ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q () -> QWithAux m q ())
    -> ([Dec] -> q ()) -> [Dec] -> QWithAux m q ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` [Dec] -> q ()
    forall (m :: * -> *). Quasi m => [Dec] -> m ()
    qAddTopDecls
      qAddModFinalizer :: Q () -> QWithAux m q ()
    qAddModFinalizer  = q () -> QWithAux m q ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q () -> QWithAux m q ())
    -> (Q () -> q ()) -> Q () -> QWithAux m q ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` Q () -> q ()
    forall (m :: * -> *). Quasi m => Q () -> m ()
    qAddModFinalizer
      qGetQ :: QWithAux m q (Maybe a)
    qGetQ             = q (Maybe a) -> QWithAux m q (Maybe a)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift q (Maybe a)
    forall (m :: * -> *) a. (Quasi m, Typeable a) => m (Maybe a)
    qGetQ
      qPutQ :: a -> QWithAux m q ()
    qPutQ             = q () -> QWithAux m q ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q () -> QWithAux m q ()) -> (a -> q ()) -> a -> QWithAux m q ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` a -> q ()
    forall (m :: * -> *) a. (Quasi m, Typeable a) => a -> m ()
    qPutQ

      qReifyFixity :: Name -> QWithAux m q (Maybe Fixity)
    qReifyFixity        = q (Maybe Fixity) -> QWithAux m q (Maybe Fixity)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q (Maybe Fixity) -> QWithAux m q (Maybe Fixity))
    -> (Name -> q (Maybe Fixity))
    -> Name
    -> QWithAux m q (Maybe Fixity)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` Name -> q (Maybe Fixity)
    forall (m :: * -> *). Quasi m => Name -> m (Maybe Fixity)
    qReifyFixity
      qReifyConStrictness :: Name -> QWithAux m q [DecidedStrictness]
    qReifyConStrictness = q [DecidedStrictness] -> QWithAux m q [DecidedStrictness]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q [DecidedStrictness] -> QWithAux m q [DecidedStrictness])
    -> (Name -> q [DecidedStrictness])
    -> Name
    -> QWithAux m q [DecidedStrictness]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` Name -> q [DecidedStrictness]
    forall (m :: * -> *). Quasi m => Name -> m [DecidedStrictness]
    qReifyConStrictness
      qIsExtEnabled :: Extension -> QWithAux m q Bool
    qIsExtEnabled       = q Bool -> QWithAux m q Bool
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q Bool -> QWithAux m q Bool)
    -> (Extension -> q Bool) -> Extension -> QWithAux m q Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` Extension -> q Bool
    forall (m :: * -> *). Quasi m => Extension -> m Bool
    qIsExtEnabled
      qExtsEnabled :: QWithAux m q [Extension]
    qExtsEnabled        = q [Extension] -> QWithAux m q [Extension]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift q [Extension]
    forall (m :: * -> *). Quasi m => m [Extension]
    qExtsEnabled
      qAddForeignFilePath :: ForeignSrcLang -> String -> QWithAux m q ()
    qAddForeignFilePath = q () -> QWithAux m q ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q () -> QWithAux m q ())
    -> (ForeignSrcLang -> String -> q ())
    -> ForeignSrcLang
    -> String
    -> QWithAux m q ()
    forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
    `comp2` ForeignSrcLang -> String -> q ()
    forall (m :: * -> *). Quasi m => ForeignSrcLang -> String -> m ()
    qAddForeignFilePath
      qAddTempFile :: String -> QWithAux m q String
    qAddTempFile        = q String -> QWithAux m q String
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q String -> QWithAux m q String)
    -> (String -> q String) -> String -> QWithAux m q String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` String -> q String
    forall (m :: * -> *). Quasi m => String -> m String
    qAddTempFile
      qAddCorePlugin :: String -> QWithAux m q ()
    qAddCorePlugin      = q () -> QWithAux m q ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q () -> QWithAux m q ())
    -> (String -> q ()) -> String -> QWithAux m q ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    `comp1` String -> q ()
    forall (m :: * -> *). Quasi m => String -> m ()
    qAddCorePlugin

      qRecover :: QWithAux m q a -> QWithAux m q a -> QWithAux m q a
    qRecover exp :: QWithAux m q a
    exp handler :: QWithAux m q a
    handler = do
        (result :: a
    result, aux :: m
    aux) <- q (a, m) -> QWithAux m q (a, m)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (q (a, m) -> QWithAux m q (a, m))
    -> q (a, m) -> QWithAux m q (a, m)
    forall a b. (a -> b) -> a -> b
    $ q (a, m) -> q (a, m) -> q (a, m)
    forall (m :: * -> *) a. Quasi m => m a -> m a -> m a
    qRecover (QWithAux m q a -> q (a, m)
    forall m (q :: * -> *) a. QWithAux m q a -> q (a, m)
    evalForPair QWithAux m q a
    exp) (QWithAux m q a -> q (a, m)
    forall m (q :: * -> *) a. QWithAux m q a -> q (a, m)
    evalForPair QWithAux m q a
    handler)
        m -> QWithAux m q ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell m
    aux
        a -> QWithAux m q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result

    instance (DsMonad q, Monoid m) => DsMonad (QWithAux m q) where
      localDeclarations :: QWithAux m q [Dec]
    localDeclarations = q [Dec] -> QWithAux m q [Dec]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift q [Dec]
    forall (m :: * -> *). DsMonad m => m [Dec]
    localDeclarations

    -- helper functions for composition
    comp1 :: (b -> c) -> (a -> b) -> a -> c
    comp1 :: (b -> c) -> (a -> b) -> a -> c
    comp1 = (b -> c) -> (a -> b) -> a -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    (.)

    comp2 :: (c -> d) -> (a -> b -> c) -> a -> b -> d
    comp2 :: (c -> d) -> (a -> b -> c) -> a -> b -> d
    comp2 f :: c -> d
    f g :: a -> b -> c
    g a :: a
    a b :: b
    b = c -> d
    f (a -> b -> c
    g a
    a b
    b)

    -- run a computation with an auxiliary monoid, discarding the monoid result
    evalWithoutAux :: Quasi q => QWithAux m q a -> q a
    evalWithoutAux :: QWithAux m q a -> q a
    evalWithoutAux = ((a, m) -> a) -> q (a, m) -> q a
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (a, m) -> a
    forall a b. (a, b) -> a
    fst (q (a, m) -> q a)
    -> (QWithAux m q a -> q (a, m)) -> QWithAux m q a -> q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WriterT m q a -> q (a, m)
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    runWriterT (WriterT m q a -> q (a, m))
    -> (QWithAux m q a -> WriterT m q a) -> QWithAux m q a -> q (a, m)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QWithAux m q a -> WriterT m q a
    forall m (q :: * -> *) a. QWithAux m q a -> WriterT m q a
    runQWA

    -- run a computation with an auxiliary monoid, returning only the monoid result
    evalForAux :: Quasi q => QWithAux m q a -> q m
    evalForAux :: QWithAux m q a -> q m
    evalForAux = WriterT m q a -> q m
    forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
    execWriterT (WriterT m q a -> q m)
    -> (QWithAux m q a -> WriterT m q a) -> QWithAux m q a -> q m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QWithAux m q a -> WriterT m q a
    forall m (q :: * -> *) a. QWithAux m q a -> WriterT m q a
    runQWA

    -- run a computation with an auxiliary monoid, return both the result
    -- of the computation and the monoid result
    evalForPair :: QWithAux m q a -> q (a, m)
    evalForPair :: QWithAux m q a -> q (a, m)
    evalForPair = WriterT m q a -> q (a, m)
    forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
    runWriterT (WriterT m q a -> q (a, m))
    -> (QWithAux m q a -> WriterT m q a) -> QWithAux m q a -> q (a, m)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . QWithAux m q a -> WriterT m q a
    forall m (q :: * -> *) a. QWithAux m q a -> WriterT m q a
    runQWA

    -- in a computation with an auxiliary map, add a binding to the map
    addBinding :: (Quasi q, Ord k) => k -> v -> QWithAux (Map.Map k v) q ()
    addBinding :: k -> v -> QWithAux (Map k v) q ()
    addBinding k :: k
    k v :: v
    v = Map k v -> QWithAux (Map k v) q ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (k -> v -> Map k v
    forall k a. k -> a -> Map k a
    Map.singleton k
    k v
    v)

    -- in a computation with an auxiliar list, add an element to the list
    addElement :: Quasi q => elt -> QWithAux [elt] q ()
    addElement :: elt -> QWithAux [elt] q ()
    addElement elt :: elt
    elt = [elt] -> QWithAux [elt] q ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell [elt
    elt]

    -- | Call 'lookupTypeNameWithLocals' first to ensure we have a 'Name' in the
    -- type namespace, then call 'dsReify'.

    -- See also Note [Using dsReifyTypeNameInfo when promoting instances]
    -- in Data.Singletons.Promote.
    dsReifyTypeNameInfo :: DsMonad q => Name -> q (Maybe DInfo)
    dsReifyTypeNameInfo :: Name -> q (Maybe DInfo)
    dsReifyTypeNameInfo ty_name :: Name
    ty_name = do
      Maybe Name
    mb_name <- String -> q (Maybe Name)
    forall (q :: * -> *). DsMonad q => String -> q (Maybe Name)
    lookupTypeNameWithLocals (Name -> String
    nameBase Name
    ty_name)
      case Maybe Name
    mb_name of
        Just n :: Name
    n  -> Name -> q (Maybe DInfo)
    forall (q :: * -> *). DsMonad q => Name -> q (Maybe DInfo)
    dsReify Name
    n
        Nothing -> Maybe DInfo -> q (Maybe DInfo)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe DInfo
    forall a. Maybe a
    Nothing

    -- lift concatMap into a monad
    -- could this be more efficient?
    concatMapM :: (Monad monad, Monoid monoid, Traversable t)
               => (a -> monad monoid) -> t a -> monad monoid
    concatMapM :: (a -> monad monoid) -> t a -> monad monoid
    concatMapM fn :: a -> monad monoid
    fn list :: t a
    list = do
      t monoid
    bss <- (a -> monad monoid) -> t a -> monad (t monoid)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM a -> monad monoid
    fn t a
    list
      monoid -> monad monoid
    forall (m :: * -> *) a. Monad m => a -> m a
    return (monoid -> monad monoid) -> monoid -> monad monoid
    forall a b. (a -> b) -> a -> b
    $ t monoid -> monoid
    forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
    fold t monoid
    bss

    -- make a one-element list
    listify :: a -> [a]
    listify :: a -> [a]
    listify = (a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[])

    fstOf3 :: (a,b,c) -> a
    fstOf3 :: (a, b, c) -> a
    fstOf3 (a :: a
    a,_,_) = a
    a

    liftFst :: (a -> b) -> (a, c) -> (b, c)
    liftFst :: (a -> b) -> (a, c) -> (b, c)
    liftFst f :: a -> b
    f (a :: a
    a, c :: c
    c) = (a -> b
    f a
    a, c
    c)

    liftSnd :: (a -> b) -> (c, a) -> (c, b)
    liftSnd :: (a -> b) -> (c, a) -> (c, b)
    liftSnd f :: a -> b
    f (c :: c
    c, a :: a
    a) = (c
    c, a -> b
    f a
    a)

    snocView :: [a] -> ([a], a)
    snocView :: [a] -> ([a], a)
    snocView [] = String -> ([a], a)
    forall a. HasCallStack => String -> a
    error "snocView nil"
    snocView [x :: a
    x] = ([], a
    x)
    snocView (x :: a
    x : xs :: [a]
    xs) = ([a] -> [a]) -> ([a], a) -> ([a], a)
    forall a b c. (a -> b) -> (a, c) -> (b, c)
    liftFst (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :) ([a] -> ([a], a)
    forall a. [a] -> ([a], a)
    snocView [a]
    xs)

    partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
    partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
    partitionWith f :: a -> Either b c
    f = [b] -> [c] -> [a] -> ([b], [c])
    go [] []
      where go :: [b] -> [c] -> [a] -> ([b], [c])
    go bs :: [b]
    bs cs :: [c]
    cs []     = ([b] -> [b]
    forall a. [a] -> [a]
    reverse [b]
    bs, [c] -> [c]
    forall a. [a] -> [a]
    reverse [c]
    cs)
            go bs :: [b]
    bs cs :: [c]
    cs (a :: a
    a:as :: [a]
    as) =
              case a -> Either b c
    f a
    a of
                Left b :: b
    b  -> [b] -> [c] -> [a] -> ([b], [c])
    go (b
    bb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    bs) [c]
    cs [a]
    as
                Right c :: c
    c -> [b] -> [c] -> [a] -> ([b], [c])
    go [b]
    bs (c
    cc -> [c] -> [c]
    forall a. a -> [a] -> [a]
    :[c]
    cs) [a]
    as

    partitionWithM :: Monad m => (a -> m (Either b c)) -> [a] -> m ([b], [c])
    partitionWithM :: (a -> m (Either b c)) -> [a] -> m ([b], [c])
    partitionWithM f :: a -> m (Either b c)
    f = [b] -> [c] -> [a] -> m ([b], [c])
    go [] []
      where go :: [b] -> [c] -> [a] -> m ([b], [c])
    go bs :: [b]
    bs cs :: [c]
    cs []     = ([b], [c]) -> m ([b], [c])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([b] -> [b]
    forall a. [a] -> [a]
    reverse [b]
    bs, [c] -> [c]
    forall a. [a] -> [a]
    reverse [c]
    cs)
            go bs :: [b]
    bs cs :: [c]
    cs (a :: a
    a:as :: [a]
    as) = do
              Either b c
    fa <- a -> m (Either b c)
    f a
    a
              case Either b c
    fa of
                Left b :: b
    b  -> [b] -> [c] -> [a] -> m ([b], [c])
    go (b
    bb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    bs) [c]
    cs [a]
    as
                Right c :: c
    c -> [b] -> [c] -> [a] -> m ([b], [c])
    go [b]
    bs (c
    cc -> [c] -> [c]
    forall a. a -> [a] -> [a]
    :[c]
    cs) [a]
    as

    partitionLetDecs :: [DDec] -> ([DLetDec], [DDec])
    partitionLetDecs :: [DDec] -> ([DLetDec], [DDec])
    partitionLetDecs = (DDec -> Either DLetDec DDec) -> [DDec] -> ([DLetDec], [DDec])
    forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
    partitionWith (\case DLetDec ld :: DLetDec
    ld -> DLetDec -> Either DLetDec DDec
    forall a b. a -> Either a b
    Left DLetDec
    ld
                                            dec :: DDec
    dec        -> DDec -> Either DLetDec DDec
    forall a b. b -> Either a b
    Right DDec
    dec)

    {-# INLINEABLE zipWith3M #-}
    zipWith3M :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWith3M :: (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWith3M f :: a -> b -> m c
    f (a :: a
    a:as :: [a]
    as) (b :: b
    b:bs :: [b]
    bs) = (:) (c -> [c] -> [c]) -> m c -> m ([c] -> [c])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> a -> b -> m c
    f a
    a b
    b m ([c] -> [c]) -> m [c] -> m [c]
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (a -> b -> m c) -> [a] -> [b] -> m [c]
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWith3M a -> b -> m c
    f [a]
    as [b]
    bs
    zipWith3M _ _ _ = [c] -> m [c]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    mapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d])
    mapAndUnzip3M :: (a -> m (b, c, d)) -> [a] -> m ([b], [c], [d])
    mapAndUnzip3M _ []     = ([b], [c], [d]) -> m ([b], [c], [d])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([],[],[])
    mapAndUnzip3M f :: a -> m (b, c, d)
    f (x :: a
    x:xs :: [a]
    xs) = do
        (r1 :: b
    r1,  r2 :: c
    r2,  r3 :: d
    r3)  <- a -> m (b, c, d)
    f a
    x
        (rs1 :: [b]
    rs1, rs2 :: [c]
    rs2, rs3 :: [d]
    rs3) <- (a -> m (b, c, d)) -> [a] -> m ([b], [c], [d])
    forall (m :: * -> *) a b c d.
    Monad m =>
    (a -> m (b, c, d)) -> [a] -> m ([b], [c], [d])
    mapAndUnzip3M a -> m (b, c, d)
    f [a]
    xs
        ([b], [c], [d]) -> m ([b], [c], [d])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b
    r1b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    rs1, c
    r2c -> [c] -> [c]
    forall a. a -> [a] -> [a]
    :[c]
    rs2, d
    r3d -> [d] -> [d]
    forall a. a -> [a] -> [a]
    :[d]
    rs3)

    -- is it a letter or underscore?
    isHsLetter :: Char -> Bool
    isHsLetter :: Char -> Bool
    isHsLetter c :: Char
    c = Char -> Bool
    isLetter Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '_'