    {-# LANGUAGE ExplicitNamespaces, CPP #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Singletons.TH
    -- Copyright   :  (C) 2013 Richard Eisenberg
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  Ryan Scott
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- This module contains everything you need to derive your own singletons via
    -- Template Haskell.
    --
    -- TURN ON @-XScopedTypeVariables@ IN YOUR MODULE IF YOU WANT THIS TO WORK.
    --
    ----------------------------------------------------------------------------

    module Data.Singletons.TH (
      -- * Primary Template Haskell generation functions
      singletons, singletonsOnly, genSingletons,
      promote, promoteOnly, genDefunSymbols, genPromotions,

      -- ** Functions to generate equality instances
      promoteEqInstances, promoteEqInstance,
      singEqInstances, singEqInstance,
      singEqInstancesOnly, singEqInstanceOnly,
      singDecideInstances, singDecideInstance,

      -- ** Functions to generate 'Ord' instances
      promoteOrdInstances, promoteOrdInstance,
      singOrdInstances, singOrdInstance,

      -- ** Functions to generate 'Bounded' instances
      promoteBoundedInstances, promoteBoundedInstance,
      singBoundedInstances, singBoundedInstance,

      -- ** Functions to generate 'Enum' instances
      promoteEnumInstances, promoteEnumInstance,
      singEnumInstances, singEnumInstance,

      -- ** Functions to generate 'Show' instances
      promoteShowInstances, promoteShowInstance,
      singShowInstances, singShowInstance,
      showSingInstances, showSingInstance,

      -- ** Utility functions
      singITyConInstances, singITyConInstance,
      cases, sCases,

      -- * Basic singleton definitions
      SBool(..), STuple0(..), STuple2(..), STuple3(..), STuple4(..),
      STuple5(..), STuple6(..), STuple7(..), SOrdering(..),
      module Data.Singletons,

      -- * Auxiliary definitions
      -- | These definitions might be mentioned in code generated by Template Haskell,
      -- so they must be in scope.

      PEq(..), If, sIf, type (&&), (%&&), SEq(..),
      POrd(..), SOrd(..), ThenCmp, sThenCmp,
      SDecide(..), (:~:)(..), Void, Refuted, Decision(..),
      PBounded(..), SBounded(..),
      PEnum(FromEnum, ToEnum), SEnum(sFromEnum, sToEnum),
      PShow(..), SShow(..),
      ShowString, sShowString, ShowParen, sShowParen, ShowSpace, sShowSpace,
      ShowChar, sShowChar, ShowCommaSpace, sShowCommaSpace,
      PFunctor(..), SFunctor(..),
      PFoldable(..), SFoldable(..), PMonoid(..), SMonoid(..),
      PTraversable(..), STraversable(..), PApplicative(..), SApplicative(..),
      type (.), (%.),
      SomeSing(..),

      Error, sError, ErrorSym0, ErrorSym1,
      Undefined, sUndefined, UndefinedSym0,
      TrueSym0, FalseSym0,
      type (==@#@$), type (==@#@$$), type (==@#@$$$),
      type (>@#@$),  type (>@#@$$),  type (>@#@$$$),
      LTSym0, EQSym0, GTSym0,
      Tuple0Sym0,
      Tuple2Sym0, Tuple2Sym1, Tuple2Sym2,
      Tuple3Sym0, Tuple3Sym1, Tuple3Sym2, Tuple3Sym3,
      Tuple4Sym0, Tuple4Sym1, Tuple4Sym2, Tuple4Sym3, Tuple4Sym4,
      Tuple5Sym0, Tuple5Sym1, Tuple5Sym2, Tuple5Sym3, Tuple5Sym4, Tuple5Sym5,
      Tuple6Sym0, Tuple6Sym1, Tuple6Sym2, Tuple6Sym3, Tuple6Sym4, Tuple6Sym5, Tuple6Sym6,
      Tuple7Sym0, Tuple7Sym1, Tuple7Sym2, Tuple7Sym3, Tuple7Sym4, Tuple7Sym5, Tuple7Sym6, Tuple7Sym7,
      CompareSym0, CompareSym1, CompareSym2,
      ThenCmpSym0, ThenCmpSym1, ThenCmpSym2,
      FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,
      MinBoundSym0, MaxBoundSym0,
      ShowsPrecSym0, ShowsPrecSym1, ShowsPrecSym2, ShowsPrecSym3,
      ShowStringSym0, ShowStringSym1, ShowStringSym2,
      ShowParenSym0, ShowParenSym1, ShowParenSym2,
      ShowSpaceSym0, ShowSpaceSym1,
      ShowCharSym0, ShowCharSym1, ShowCharSym2,
      ShowCommaSpaceSym0, ShowCommaSpaceSym1,
      FmapSym0, FmapSym1, FmapSym2,
      type (<$@#@$),  type (<$@#@$$),  type (<$@#@$$$),
      FoldMapSym0, FoldMapSym1, FoldMapSym2,
      MemptySym0,
      MappendSym0, MappendSym1, MappendSym2,
      FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,
      TraverseSym0, TraverseSym1, TraverseSym2,
      PureSym0, PureSym1,
      type (<*>@#@$), type (<*>@#@$$), type (<*>@#@$$$),
      LiftA2Sym0, LiftA2Sym1, LiftA2Sym2, LiftA2Sym3,
      type (.@#@$), type (.@#@$$), type (.@#@$$$), type (.@#@$$$$),
      (:@#@$), (:@#@$$), (:@#@$$$),

      SuppressUnusedWarnings(..)

     ) where

    import Data.Singletons
    import Data.Singletons.Single
    import Data.Singletons.Promote
    import Data.Singletons.Prelude.Applicative
    import Data.Singletons.Prelude.Base
      hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)
    import Data.Singletons.Prelude.Instances
      hiding (Foldl, FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3, sFoldl)
    import Data.Singletons.Prelude.Bool
    import Data.Singletons.Prelude.Enum
    import Data.Singletons.Prelude.Eq
    import Data.Singletons.Prelude.Foldable
    import Data.Singletons.Prelude.Functor hiding (Void)
    import Data.Singletons.Prelude.Monoid
    import Data.Singletons.Prelude.Ord
    import Data.Singletons.Prelude.Show
    import Data.Singletons.Prelude.Traversable
    import Data.Singletons.Decide
    import Data.Singletons.TypeLits
    import Data.Singletons.SuppressUnusedWarnings
    import Data.Singletons.Names
    import Language.Haskell.TH.Desugar

    import Language.Haskell.TH
    import Data.Singletons.Util
    import Control.Arrow ( first )

    -- | The function 'cases' generates a case expression where each right-hand side
    -- is identical. This may be useful if the type-checker requires knowledge of which
    -- constructor is used to satisfy equality or type-class constraints, but where
    -- each constructor is treated the same.
    cases :: DsMonad q
          => Name        -- ^ The head of the type of the scrutinee. (Like @''Maybe@ or @''Bool@.)
          -> q Exp       -- ^ The scrutinee, in a Template Haskell quote
          -> q Exp       -- ^ The body, in a Template Haskell quote
          -> q Exp
    cases :: Name -> q Exp -> q Exp -> q Exp
    cases tyName :: Name
    tyName expq :: q Exp
    expq bodyq :: q Exp
    bodyq = do
      Maybe DInfo
    dinfo <- Name -> q (Maybe DInfo)
    forall (q :: * -> *). DsMonad q => Name -> q (Maybe DInfo)
    dsReify Name
    tyName
      case Maybe DInfo
    dinfo of
        Just (DTyConI (DDataD _ _ _ _ _ ctors :: [DCon]
    ctors _) _) ->
          DExp -> Exp
    expToTH (DExp -> Exp) -> q DExp -> q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Name, Int)] -> q Exp -> q Exp -> q DExp
    forall (m :: * -> *).
    DsMonad m =>
    [(Name, Int)] -> m Exp -> m Exp -> m DExp
    buildCases ((DCon -> (Name, Int)) -> [DCon] -> [(Name, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map DCon -> (Name, Int)
    extractNameArgs [DCon]
    ctors) q Exp
    expq q Exp
    bodyq
        Just _ ->
          String -> q Exp
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q Exp) -> String -> q Exp
    forall a b. (a -> b) -> a -> b
    $ "Using <<cases>> with something other than a type constructor: "
                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Name -> String
    forall a. Show a => a -> String
    show Name
    tyName)
        _ -> String -> q Exp
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q Exp) -> String -> q Exp
    forall a b. (a -> b) -> a -> b
    $ "Cannot find " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Show a => a -> String
    show Name
    tyName

    -- | The function 'sCases' generates a case expression where each right-hand side
    -- is identical. This may be useful if the type-checker requires knowledge of which
    -- constructor is used to satisfy equality or type-class constraints, but where
    -- each constructor is treated the same. For 'sCases', unlike 'cases', the
    -- scrutinee is a singleton. But make sure to pass in the name of the /original/
    -- datatype, preferring @''Maybe@ over @''SMaybe@.
    sCases :: DsMonad q
           => Name        -- ^ The head of the type the scrutinee's type is based on.
                          -- (Like @''Maybe@ or @''Bool@.)
           -> q Exp       -- ^ The scrutinee, in a Template Haskell quote
           -> q Exp       -- ^ The body, in a Template Haskell quote
           -> q Exp
    sCases :: Name -> q Exp -> q Exp -> q Exp
    sCases tyName :: Name
    tyName expq :: q Exp
    expq bodyq :: q Exp
    bodyq = do
      Maybe DInfo
    dinfo <- Name -> q (Maybe DInfo)
    forall (q :: * -> *). DsMonad q => Name -> q (Maybe DInfo)
    dsReify Name
    tyName
      case Maybe DInfo
    dinfo of
        Just (DTyConI (DDataD _ _ _ _ _ ctors :: [DCon]
    ctors _) _) ->
          let ctor_stuff :: [(Name, Int)]
    ctor_stuff = (DCon -> (Name, Int)) -> [DCon] -> [(Name, Int)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Name -> Name) -> (Name, Int) -> (Name, Int)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first Name -> Name
    singDataConName ((Name, Int) -> (Name, Int))
    -> (DCon -> (Name, Int)) -> DCon -> (Name, Int)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DCon -> (Name, Int)
    extractNameArgs) [DCon]
    ctors in
          DExp -> Exp
    expToTH (DExp -> Exp) -> q DExp -> q Exp
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(Name, Int)] -> q Exp -> q Exp -> q DExp
    forall (m :: * -> *).
    DsMonad m =>
    [(Name, Int)] -> m Exp -> m Exp -> m DExp
    buildCases [(Name, Int)]
    ctor_stuff q Exp
    expq q Exp
    bodyq
        Just _ ->
          String -> q Exp
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q Exp) -> String -> q Exp
    forall a b. (a -> b) -> a -> b
    $ "Using <<cases>> with something other than a type constructor: "
                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Name -> String
    forall a. Show a => a -> String
    show Name
    tyName)
        _ -> String -> q Exp
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> q Exp) -> String -> q Exp
    forall a b. (a -> b) -> a -> b
    $ "Cannot find " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Show a => a -> String
    show Name
    tyName

    buildCases :: DsMonad m
               => [(Name, Int)]
               -> m Exp  -- scrutinee
               -> m Exp  -- body
               -> m DExp
    buildCases :: [(Name, Int)] -> m Exp -> m Exp -> m DExp
    buildCases ctor_infos :: [(Name, Int)]
    ctor_infos expq :: m Exp
    expq bodyq :: m Exp
    bodyq =
      DExp -> [DMatch] -> DExp
    DCaseE (DExp -> [DMatch] -> DExp) -> m DExp -> m ([DMatch] -> DExp)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Exp -> m DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp (Exp -> m DExp) -> m Exp -> m DExp
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< m Exp
    expq) m ([DMatch] -> DExp) -> m [DMatch] -> m DExp
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*>
                 ((Name, Int) -> m DMatch) -> [(Name, Int)] -> m [DMatch]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\con :: (Name, Int)
    con -> DPat -> DExp -> DMatch
    DMatch ((Name, Int) -> DPat
    conToPat (Name, Int)
    con) (DExp -> DMatch) -> m DExp -> m DMatch
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Exp -> m DExp
    forall (q :: * -> *). DsMonad q => Exp -> q DExp
    dsExp (Exp -> m DExp) -> m Exp -> m DExp
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< m Exp
    bodyq)) [(Name, Int)]
    ctor_infos
      where
        conToPat :: (Name, Int) -> DPat
        conToPat :: (Name, Int) -> DPat
    conToPat (name :: Name
    name, num_fields :: Int
    num_fields) =
          Name -> [DPat] -> DPat
    DConP Name
    name (Int -> DPat -> [DPat]
    forall a. Int -> a -> [a]
    replicate Int
    num_fields DPat
    DWildP)