{-# LANGUAGE OverloadedStrings #-}
module Data.Morpheus.CodeGen.Internal.Name
( toHaskellTypeName,
camelCaseTypeName,
toHaskellName,
camelCaseFieldName,
)
where
import Data.Char
( toLower,
toUpper,
)
import qualified Data.Morpheus.Types.Internal.AST as N
import Data.Morpheus.Types.Internal.AST
( FieldName,
TypeName,
packName,
unpackName,
)
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 (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
x) Text -> Text -> Text
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 :: [Name t] -> TypeName -> TypeName
camelCaseTypeName [Name t]
list TypeName
name =
Text -> TypeName
forall (t :: NAME). Text -> Name t
packName (Text -> TypeName) -> Text -> TypeName
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
(Name t -> Text) -> [Name t] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
capitalize (Text -> Text) -> (Name t -> Text) -> Name t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name t -> Text
forall (t :: NAME). Name t -> Text
unpackName) ([Name t]
list [Name t] -> [Name t] -> [Name t]
forall a. Semigroup a => a -> a -> a
<> [TypeName -> Name t
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 -> Text
capitalize (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ TypeName -> Text
forall (t :: NAME). Name t -> Text
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 =
Text -> FieldName
forall (t :: NAME). Text -> Name t
packName (Text -> FieldName) -> Text -> FieldName
forall a b. (a -> b) -> a -> b
$
Text -> Text
uncapitalize (TypeName -> Text
forall (t :: NAME). Name t -> Text
unpackName TypeName
nSpace)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
capitalize (FieldName -> Text
forall (t :: NAME). Name t -> Text
unpackName FieldName
name)
toHaskellName :: FieldName -> String
toHaskellName :: FieldName -> String
toHaskellName FieldName
name
| FieldName -> Bool
isReserved FieldName
name = Text -> String
T.unpack (FieldName -> Text
forall (t :: NAME). Name t -> Text
unpackName FieldName
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")
| Bool
otherwise = Text -> String
T.unpack (Text -> Text
uncapitalize (FieldName -> Text
forall (t :: NAME). Name t -> Text
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 #-}