    -- |
    -- 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 :: String -> String
    capitalize (c :: Char
    c:cs :: String
    cs) = Char -> Char
    toUpper Char
    c Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    cs
    capitalize ""     = ""

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

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

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

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

    -- | All reserved identifiers. Taken from section 2.4 of the 2010 Report.
    reservedIds :: Set String
    reservedIds :: Set String
    reservedIds = [String] -> Set String
    forall a. Ord a => [a] -> Set a
    fromList [ "case", "class", "data", "default", "deriving"
                           , "do", "else", "foreign", "if", "import", "in"
                           , "infix", "infixl", "infixr", "instance", "let"
                           , "module", "newtype", "of", "then", "type", "where"
                           , "_" ]
    {-# 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 :: String -> ConName
    toConName =  Name -> ConName
    ConName (Name -> ConName) -> (String -> Name) -> String -> ConName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Name
    mkName (String -> Name) -> (String -> String) -> String -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    rename (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    capitalize (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 String -> String
    allowedChars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    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 :: String -> VarName
    toVarName =  Name -> VarName
    VarName (Name -> VarName) -> (String -> Name) -> String -> VarName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Name
    mkName (String -> Name) -> (String -> String) -> String -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    rename (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    unCapitalize (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                 String -> String
    allowedChars (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    letterStart

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

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

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

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

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

    -- | Make camel-cased variable name from 'String'.
    varCamelcaseName :: String -> VarName
    varCamelcaseName :: String -> VarName
    varCamelcaseName =  String -> VarName
    toVarName (String -> VarName) -> (String -> String) -> String -> VarName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    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
    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
    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
    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
    varP (Name -> PatQ) -> (VarName -> Name) -> VarName -> PatQ
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VarName -> Name
    varName