    -- |
    -- Module      : Language.Haskell.TH.Name.CamelCase
    -- Copyright   : 2013-2018 Kei Hibino, 2015 Shohei Murayama
    -- License     : BSD3
    --
    -- Maintainer  : ex8k.hibino@gmail.com
    -- Stability   : experimental
    -- Portability : unknown
    --
    -- This module provides camelcased 'Name' for Template Haskell
    module Language.Haskell.TH.Name.CamelCase (
      -- * Types to wrap 'Name'
      -- $nameTypes
      ConName (ConName, conName), toConName,
      VarName (VarName, varName), toVarName,

      -- * Functions to make camel-cased names
      -- $makeNames
      conCamelcaseName, varCamelcaseName,

      -- * Functions to generate haskell template from names
      -- $makeTemplates
      toTypeCon, toDataCon,

      toVarExp, toVarPat,
      ) where

    import Data.Char (toUpper, toLower, isLetter, isDigit)
    import Data.Set (Set, fromList, member)
    import Language.Haskell.TH
      (Name, mkName, TypeQ, conT, ExpQ, conE, varE, PatQ, varP)

    capitalize :: String -> String
    capitalize :: [Char] -> [Char]
    capitalize (Char
    c:[Char]
    cs) = Char -> Char
    toUpper Char
    c Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char]
    cs
    capitalize [Char]
    ""     = [Char]
    ""

    unCapitalize :: String -> String
    unCapitalize :: [Char] -> [Char]
    unCapitalize (Char
    c:[Char]
    cs) = Char -> Char
    toLower Char
    c Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char]
    cs
    unCapitalize [Char]
    ""     = [Char]
    ""

    -- Adds a _ to the identifier which does not start with a letter or an
    -- underscore.
    letterStart :: String -> String
    letterStart :: [Char] -> [Char]
    letterStart (Char
    c:[Char]
    cs) | Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '_'   Bool -> Bool -> Bool
    ||
                         Char -> Bool
    isLetter Char
    c    = Char
    cChar -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :[Char]
    cs
                       | Bool
    otherwise     = Char
    '_'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :Char
    cChar -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :[Char]
    cs
    letterStart [Char]
    ""                     = [Char]
    ""

    -- Only letters, digits, underscores and single quotes are allowed in an
    -- identifier.
    allowedChars :: String -> String
    allowedChars :: [Char] -> [Char]
    allowedChars [Char]
    cs = (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    replaceUnallowed [Char]
    cs
      where
        replaceUnallowed :: Char -> Char
    replaceUnallowed Char
    c | Char -> Bool
    isLetter Char
    c    Bool -> Bool -> Bool
    ||
                             Char -> Bool
    isDigit  Char
    c    Bool -> Bool -> Bool
    ||
                             Char
    c Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char]
    "_'"    = Char
    c
                           | Bool
    otherwise        = Char
    '_'

    -- | rename the string that equals to reserved identifiers.
    rename :: String -> String
    rename :: [Char] -> [Char]
    rename [Char]
    cs | [Char]
    cs [Char] -> Set [Char] -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `member` Set [Char]
    reservedIds = [Char]
    cs [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "_"
              | Bool
    otherwise = [Char]
    cs
    {-# INLINE rename #-}

    -- | All reserved identifiers. Taken from section 2.4 of the 2010 Report.
    reservedIds :: Set String
    reservedIds :: Set [Char]
    reservedIds = [[Char]] -> Set [Char]
    forall a. Ord a => [a] -> Set a
    fromList [ [Char]
    "case", [Char]
    "class", [Char]
    "data", [Char]
    "default", [Char]
    "deriving"
                           , [Char]
    "do", [Char]
    "else", [Char]
    "foreign", [Char]
    "if", [Char]
    "import", [Char]
    "in"
                           , [Char]
    "infix", [Char]
    "infixl", [Char]
    "infixr", [Char]
    "instance", [Char]
    "let"
                           , [Char]
    "module", [Char]
    "newtype", [Char]
    "of", [Char]
    "then", [Char]
    "type", [Char]
    "where"
                           , [Char]
    "_" ]
    {-# INLINE reservedIds #-}

    {- $nameTypes
    Wrap 'Name' to distinguish constructor names and variable names.
    -}

    -- | Type to wrap constructor\'s 'Name'.
    newtype ConName = ConName { ConName -> Name
    conName :: Name {- ^ Get wrapped 'Name' -} }

    -- | Make constructor name from 'String'.
    toConName :: String -> ConName
    toConName :: [Char] -> ConName
    toConName =  Name -> ConName
    ConName (Name -> ConName) -> ([Char] -> Name) -> [Char] -> ConName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Name
    mkName ([Char] -> Name) -> ([Char] -> [Char]) -> [Char] -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    rename ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    capitalize ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 [Char] -> [Char]
    allowedChars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    letterStart

    -- | Type to wrap variable\'s 'Name'.
    newtype VarName = VarName { VarName -> Name
    varName :: Name {- ^ Get wrapped 'Name' -} }

    -- | Make variable name from 'String'.
    toVarName :: String -> VarName
    toVarName :: [Char] -> VarName
    toVarName =  Name -> VarName
    VarName (Name -> VarName) -> ([Char] -> Name) -> [Char] -> VarName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Name
    mkName ([Char] -> Name) -> ([Char] -> [Char]) -> [Char] -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    rename ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    unCapitalize ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 [Char] -> [Char]
    allowedChars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    letterStart

    -- | 'Char' set used from camel-cased names.
    nameChars :: String
    nameChars :: [Char]
    nameChars =  Char
    '\'' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : [Char
    '0' .. Char
    '9'] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    'A' .. Char
    'Z'] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++  [Char
    'a' .. Char
    'z']

    -- | Split into chunks to generate camel-cased 'String'.
    splitForName :: String -> [String]
    splitForName :: [Char] -> [[Char]]
    splitForName [Char]
    str
      | [Char]
    rest [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [] = [Char]
    tk [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [Char] -> [[Char]]
    splitForName ([Char] -> [Char]
    forall a. HasCallStack => [a] -> [a]
    tail [Char]
    rest)
      | Bool
    otherwise  = [[Char]
    tk]
      where
        ([Char]
    tk, [Char]
    rest) = (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> [Char] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Char]
    nameChars) [Char]
    str

    {- $makeNames
    Make camel-cased names.
    -}

    -- | Convert into camel-cased 'String'.
    --   First 'Char' of result is upper case.
    camelcaseUpper :: String -> String
    camelcaseUpper :: [Char] -> [Char]
    camelcaseUpper =  ([Char] -> [Char]) -> [[Char]] -> [Char]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap [Char] -> [Char]
    capitalize ([[Char]] -> [Char]) -> ([Char] -> [[Char]]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [[Char]]
    splitForName

    -- | Make camel-cased constructor name from 'String'.
    conCamelcaseName :: String -> ConName
    conCamelcaseName :: [Char] -> ConName
    conCamelcaseName =  [Char] -> ConName
    toConName ([Char] -> ConName) -> ([Char] -> [Char]) -> [Char] -> ConName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    camelcaseUpper

    -- | Make camel-cased variable name from 'String'.
    varCamelcaseName :: String -> VarName
    varCamelcaseName :: [Char] -> VarName
    varCamelcaseName =  [Char] -> VarName
    toVarName ([Char] -> VarName) -> ([Char] -> [Char]) -> [Char] -> VarName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char]
    camelcaseUpper

    {- $makeTemplates
    Make haskell templates from names.
    -}

    -- | Make type constructor 'TypeQ' monad from constructor name type.
    toTypeCon :: ConName -> TypeQ
    toTypeCon :: ConName -> TypeQ
    toTypeCon =  Name -> TypeQ
    forall (m :: * -> *). Quote m => Name -> m Type
    conT (Name -> TypeQ) -> (ConName -> Name) -> ConName -> TypeQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConName -> Name
    conName

    -- | Make data constructor 'ExpQ' monad from constructor name type.
    toDataCon :: ConName -> ExpQ
    toDataCon :: ConName -> ExpQ
    toDataCon =  Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE (Name -> ExpQ) -> (ConName -> Name) -> ConName -> ExpQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConName -> Name
    conName

    -- | Make variable 'ExpQ' monad from variable name type.
    toVarExp :: VarName -> ExpQ
    toVarExp :: VarName -> ExpQ
    toVarExp =  Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    varE (Name -> ExpQ) -> (VarName -> Name) -> VarName -> ExpQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VarName -> Name
    varName

    -- | Make pattern 'PatQ' monad from variable name type.
    toVarPat :: VarName -> PatQ
    toVarPat :: VarName -> PatQ
    toVarPat =  Name -> PatQ
    forall (m :: * -> *). Quote m => Name -> m Pat
    varP (Name -> PatQ) -> (VarName -> Name) -> VarName -> PatQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VarName -> Name
    varName