    {-# LANGUAGE CPP #-}
    #ifndef MIN_VERSION_template_haskell
    #define MIN_VERSION_template_haskell(x,y,z) 1
    #endif
    module Data.Proxy.TH
      ( pr
    #if MIN_VERSION_template_haskell(2,8,0)
      , pr1
    #endif
      ) where

    import Data.Char
    #if __GLASGOW_HASKELL__ < 710
    import Data.Functor
    #endif
    #if __GLASGOW_HASKELL__ < 707
    import Data.Version (showVersion)
    import Paths_tagged
    #endif
    import Language.Haskell.TH
    import Language.Haskell.TH.Quote
    import Language.Haskell.TH.Syntax

    proxy_d, proxy_tc :: Name
    #if __GLASGOW_HASKELL__ >= 707
    proxy_d :: Name
    proxy_d  = String -> String -> String -> Name
    mkNameG_d "base" "Data.Proxy" "Proxy"
    proxy_tc :: Name
    proxy_tc = String -> String -> String -> Name
    mkNameG_tc "base" "Data.Proxy" "Proxy"
    #else
    proxy_d  = mkNameG_d taggedPackageKey "Data.Proxy" "Proxy"
    proxy_tc = mkNameG_tc taggedPackageKey "Data.Proxy" "Proxy"

    -- note: On 7.10+ this would use CURRENT_PACKAGE_KEY if we still housed the key.
    taggedPackageKey :: String
    taggedPackageKey = "tagged-" ++ showVersion version
    #endif

    proxyTypeQ :: TypeQ -> TypeQ
    proxyTypeQ :: TypeQ -> TypeQ
    proxyTypeQ t :: TypeQ
    t = TypeQ -> TypeQ -> TypeQ
    appT (Name -> TypeQ
    conT Name
    proxy_tc) TypeQ
    t

    proxyExpQ :: TypeQ -> ExpQ
    proxyExpQ :: TypeQ -> ExpQ
    proxyExpQ t :: TypeQ
    t = ExpQ -> TypeQ -> ExpQ
    sigE (Name -> ExpQ
    conE Name
    proxy_d) (TypeQ -> TypeQ
    proxyTypeQ TypeQ
    t)

    proxyPatQ :: TypeQ -> PatQ
    proxyPatQ :: TypeQ -> PatQ
    proxyPatQ t :: TypeQ
    t = PatQ -> TypeQ -> PatQ
    sigP (Name -> [PatQ] -> PatQ
    conP Name
    proxy_d []) (TypeQ -> TypeQ
    proxyTypeQ TypeQ
    t)

    -- | A proxy value quasiquoter. @[pr|T|]@ will splice an expression
    -- @Proxy::Proxy T@, while @[pr|A,B,C|]@ will splice in a value of
    -- @Proxy :: Proxy [A,B,C]@.

    -- TODO: parse a richer syntax for the types involved here so we can include spaces, applications, etc.
    pr :: QuasiQuoter
    pr :: QuasiQuoter
    pr = (String -> ExpQ)
    -> (String -> PatQ)
    -> (String -> TypeQ)
    -> (String -> Q [Dec])
    -> QuasiQuoter
    QuasiQuoter ((TypeQ -> ExpQ) -> String -> ExpQ
    forall r. (TypeQ -> r) -> String -> r
    mkProxy TypeQ -> ExpQ
    proxyExpQ) ((TypeQ -> PatQ) -> String -> PatQ
    forall r. (TypeQ -> r) -> String -> r
    mkProxy TypeQ -> PatQ
    proxyPatQ) ((TypeQ -> TypeQ) -> String -> TypeQ
    forall r. (TypeQ -> r) -> String -> r
    mkProxy TypeQ -> TypeQ
    proxyTypeQ) String -> Q [Dec]
    forall a. HasCallStack => a
    undefined where
      mkProxy :: (TypeQ -> r) -> String -> r
      mkProxy :: (TypeQ -> r) -> String -> r
    mkProxy p :: TypeQ -> r
    p s :: String
    s = case [String]
    ts of
        [h :: String
    h@(t :: Char
    t:_)]
           | Char -> Bool
    isUpper Char
    t -> TypeQ -> r
    p (TypeQ -> r) -> TypeQ -> r
    forall a b. (a -> b) -> a -> b
    $ [Type] -> Type
    forall a. [a] -> a
    head ([Type] -> Type) -> Q [Type] -> TypeQ
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q [Type]
    cons
           | Bool
    otherwise -> TypeQ -> r
    p (TypeQ -> r) -> TypeQ -> r
    forall a b. (a -> b) -> a -> b
    $ Name -> TypeQ
    varT (Name -> TypeQ) -> Name -> TypeQ
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    mkName String
    h
    #if MIN_VERSION_template_haskell(2,8,0)
        _ -> TypeQ -> r
    p (TypeQ -> r) -> TypeQ -> r
    forall a b. (a -> b) -> a -> b
    $ [Type] -> Type
    mkList ([Type] -> Type) -> Q [Type] -> TypeQ
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Q [Type]
    cons
    #endif
        where
          ts :: [String]
    ts = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    strip ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Char -> String -> [String]
    forall a. Eq a => a -> [a] -> [[a]]
    splitOn ',' String
    s
          cons :: Q [Type]
    cons = (String -> TypeQ) -> [String] -> Q [Type]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Name -> TypeQ
    conT (Name -> TypeQ) -> (String -> Name) -> String -> TypeQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Name
    mkName) [String]
    ts
    #if MIN_VERSION_template_haskell(2,8,0)
          mkList :: [Type] -> Type
    mkList = (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Type -> Type -> Type
    AppT (Type -> Type -> Type) -> (Type -> Type) -> Type -> Type -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Type -> Type
    AppT Type
    PromotedConsT) Type
    PromotedNilT
    #endif

    #if MIN_VERSION_template_haskell(2,8,0)
    -- | Like 'pr', but takes a single type, which is used to produce a
    -- 'Proxy' for a single-element list containing only that type. This
    -- is useful for passing a single type to a function that wants a list
    -- of types.

    -- TODO: parse a richer syntax for the types involved here so we can include spaces, applications, etc.
    pr1 :: QuasiQuoter
    pr1 :: QuasiQuoter
    pr1 = (String -> ExpQ)
    -> (String -> PatQ)
    -> (String -> TypeQ)
    -> (String -> Q [Dec])
    -> QuasiQuoter
    QuasiQuoter ((TypeQ -> ExpQ) -> String -> ExpQ
    forall r. (TypeQ -> r) -> String -> r
    mkProxy TypeQ -> ExpQ
    proxyExpQ) ((TypeQ -> PatQ) -> String -> PatQ
    forall r. (TypeQ -> r) -> String -> r
    mkProxy TypeQ -> PatQ
    proxyPatQ) ((TypeQ -> TypeQ) -> String -> TypeQ
    forall r. (TypeQ -> r) -> String -> r
    mkProxy TypeQ -> TypeQ
    proxyTypeQ) String -> Q [Dec]
    forall a. HasCallStack => a
    undefined where
      sing :: Type -> Type
    sing x :: Type
    x = Type -> Type -> Type
    AppT (Type -> Type -> Type
    AppT Type
    PromotedConsT Type
    x) Type
    PromotedNilT
      mkProxy :: (TypeQ -> p) -> String -> p
    mkProxy p :: TypeQ -> p
    p s :: String
    s = case String
    s of
        t :: Char
    t:_
          | Char -> Bool
    isUpper Char
    t -> TypeQ -> p
    p ((Type -> Type) -> TypeQ -> TypeQ
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Type -> Type
    sing (Name -> TypeQ
    conT (Name -> TypeQ) -> Name -> TypeQ
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    mkName String
    s))
          | Bool
    otherwise -> TypeQ -> p
    p ((Type -> Type) -> TypeQ -> TypeQ
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Type -> Type
    sing (Name -> TypeQ
    varT (Name -> TypeQ) -> Name -> TypeQ
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    mkName String
    s))
        _ -> String -> p
    forall a. HasCallStack => String -> a
    error "Empty string passed to pr1"
    #endif

    -- | Split on a delimiter.
    splitOn :: Eq a => a -> [a] -> [[a]]
    splitOn :: a -> [a] -> [[a]]
    splitOn d :: a
    d = [a] -> [[a]]
    go where
      go :: [a] -> [[a]]
    go [] = []
      go xs :: [a]
    xs = case [a]
    t of
          [] -> [[a]
    h]
          (_:t' :: [a]
    t') -> [a]
    h [a] -> [[a]] -> [[a]]
    forall a. a -> [a] -> [a]
    : [a] -> [[a]]
    go [a]
    t'
        where (h :: [a]
    h,t :: [a]
    t) = (a -> Bool) -> [a] -> ([a], [a])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    d) [a]
    xs

    -- | Remove white space from both ends of a 'String'.
    strip :: String -> String
    strip :: String -> String
    strip = (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace