{-# LANGUAGE OverloadedStrings #-}
module Data.Morpheus.CodeGen.Internal.Name
( toHaskellTypeName,
camelCaseTypeName,
toHaskellName,
camelCaseFieldName,
)
where
import Data.Char
( toLower,
toUpper,
)
import Data.Morpheus.Types.Internal.AST
( FieldName,
TypeName,
packName,
unpackName,
)
import qualified Data.Morpheus.Types.Internal.AST as N
import qualified Data.Text as T
import Relude hiding
( ToString (..),
Type,
)
mapFstChar :: (Char -> Char) -> Text -> Text
mapFstChar :: (Char -> Char) -> Text -> Text
mapFstChar Char -> Char
f Text
x
| Text -> Bool
T.null Text
x = Text
x
| Bool
otherwise = Char -> Text
T.singleton (Char -> Char
f forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
x) forall a. Semigroup a => a -> a -> a
<> Text -> Text
T.tail Text
x
capitalize :: Text -> Text
capitalize :: Text -> Text
capitalize = (Char -> Char) -> Text -> Text
mapFstChar Char -> Char
toUpper
camelCaseTypeName :: [N.Name t] -> TypeName -> TypeName
camelCaseTypeName :: forall (t :: NAME). [Name t] -> TypeName -> TypeName
camelCaseTypeName [Name t]
list TypeName
name =
forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$
[Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
capitalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName) ([Name t]
list forall a. Semigroup a => a -> a -> a
<> [coerce :: forall a b. Coercible a b => a -> b
coerce TypeName
name])
toHaskellTypeName :: TypeName -> Text
toHaskellTypeName :: TypeName -> Text
toHaskellTypeName TypeName
"String" = Text
"Text"
toHaskellTypeName TypeName
"Boolean" = Text
"Bool"
toHaskellTypeName TypeName
"Float" = Text
"Double"
toHaskellTypeName TypeName
name
| Text -> Char
T.head (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name) forall a. Eq a => a -> a -> Bool
== Char
'_' = Text -> Text
capitalize forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name)
| Bool
otherwise = Text -> Text
capitalize forall a b. (a -> b) -> a -> b
$ forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name
{-# INLINE toHaskellTypeName #-}
uncapitalize :: Text -> Text
uncapitalize :: Text -> Text
uncapitalize = (Char -> Char) -> Text -> Text
mapFstChar Char -> Char
toLower
camelCaseFieldName :: TypeName -> FieldName -> FieldName
camelCaseFieldName :: TypeName -> FieldName -> FieldName
camelCaseFieldName TypeName
nSpace FieldName
name =
forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$
Text -> Text
uncapitalize (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
nSpace)
forall a. Semigroup a => a -> a -> a
<> Text -> Text
capitalize (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
name)
toHaskellName :: FieldName -> String
toHaskellName :: FieldName -> String
toHaskellName FieldName
name
| FieldName -> Bool
isReserved FieldName
name = Text -> String
T.unpack (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
name forall a. Semigroup a => a -> a -> a
<> Text
"'")
| Bool
otherwise = Text -> String
T.unpack (Text -> Text
uncapitalize (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
name))
{-# INLINE toHaskellName #-}
isReserved :: FieldName -> Bool
isReserved :: FieldName -> Bool
isReserved FieldName
"case" = Bool
True
isReserved FieldName
"class" = Bool
True
isReserved FieldName
"data" = Bool
True
isReserved FieldName
"default" = Bool
True
isReserved FieldName
"deriving" = Bool
True
isReserved FieldName
"do" = Bool
True
isReserved FieldName
"else" = Bool
True
isReserved FieldName
"foreign" = Bool
True
isReserved FieldName
"if" = Bool
True
isReserved FieldName
"import" = Bool
True
isReserved FieldName
"in" = Bool
True
isReserved FieldName
"infix" = Bool
True
isReserved FieldName
"infixl" = Bool
True
isReserved FieldName
"infixr" = Bool
True
isReserved FieldName
"instance" = Bool
True
isReserved FieldName
"let" = Bool
True
isReserved FieldName
"module" = Bool
True
isReserved FieldName
"newtype" = Bool
True
isReserved FieldName
"of" = Bool
True
isReserved FieldName
"then" = Bool
True
isReserved FieldName
"type" = Bool
True
isReserved FieldName
"where" = Bool
True
isReserved FieldName
"_" = Bool
True
isReserved FieldName
_ = Bool
False
{-# INLINE isReserved #-}