{-|
Module: IHP.NameSupport
Description:  Transforms names, e.g. table names to model names
Copyright: (c) digitally induced GmbH, 2020
-}
module IHP.NameSupport
( tableNameToModelName
, columnNameToFieldName
, modelNameToTableName
, humanize
, ucfirst
, lcfirst
, fieldNameToColumnName
, escapeHaskellKeyword
, tableNameToControllerName
, enumValueToControllerName
, toSlug
, module IHP.NameSupport.Inflections
, fieldNameToFieldLabel
, columnNameToFieldLabel
, removeIdSuffix
) where

import Prelude hiding (splitAt, words, map)
import IHP.HaskellSupport
import Data.Text
import Data.String.Conversions (cs)
import qualified Data.Char as Char
import qualified Text.Inflections as Inflector
import qualified Data.Maybe as Maybe
import qualified Data.List as List
import Control.Monad (join)
import IHP.NameSupport.Inflections
import qualified Text.Inflections
import qualified Data.Text as Text

-- | Transforms a underscore table name to a camel case model name.
--
-- >>> tableNameToModelName "users"
-- "User"
--
-- >>> tableNameToModelName "projects"
-- "Project"
tableNameToModelName :: Text -> Text
tableNameToModelName :: Text -> Text
tableNameToModelName Text
"brain_waves" = Text
"BrainWave"
tableNameToModelName Text
tableName = do
    let singularizedTableName :: Text
singularizedTableName = forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Text
singularize Text
tableName)
    if Text
"_" Text -> Text -> Bool
`isInfixOf` Text
singularizedTableName
        then forall {a} {a} {b}. (Show a, Show a) => a -> Either a b -> b
unwrapEither Text
tableName forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Either (ParseErrorBundle Text Void) Text
Inflector.toCamelCased Bool
True forall a b. (a -> b) -> a -> b
$ Text
singularizedTableName
        else Text -> Text
ucfirst Text
singularizedTableName
{-# INLINABLE tableNameToModelName #-}

-- | Transforms a underscore table name to a name for a controller
--
-- >>> tableNameToControllerName "users"
-- "Users"
--
-- >>> tableNameToControllerName "projects"
-- "Projects"
--
-- >>> tableNameToControllerName "user_projects"
-- "UserProjects"
tableNameToControllerName :: Text -> Text
tableNameToControllerName :: Text -> Text
tableNameToControllerName Text
tableName = do
    if Text
"_" Text -> Text -> Bool
`isInfixOf` Text
tableName
        then forall {a} {a} {b}. (Show a, Show a) => a -> Either a b -> b
unwrapEither Text
tableName forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Either (ParseErrorBundle Text Void) Text
Inflector.toCamelCased Bool
True Text
tableName
        else Text -> Text
ucfirst Text
tableName
{-# INLINABLE tableNameToControllerName #-}

-- | Transforms a enum value to a name for a model
--
-- >>> enumValueToControllerName "happy"
-- "Happy"
--
-- >>> enumValueToControllerName "very happy"
-- "VeryHappy"
--
-- >>> enumValueToControllerName "very_happy"
-- "VeryHappy"
enumValueToControllerName :: Text -> Text
enumValueToControllerName :: Text -> Text
enumValueToControllerName Text
enumValue =
    let
        words :: [Inflector.SomeWord]
        words :: [SomeWord]
words =
                Text
enumValue
                forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text -> [Text]
splitOn Text
" "
                forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a b. (a -> b) -> [a] -> [b]
List.map (forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym)
-> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
Inflector.parseSnakeCase [])
                forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall a b. (a -> b) -> [a] -> [b]
List.map (\case
                        Left ParseErrorBundle Text Void
failed -> forall a. HasCallStack => String -> a
error (forall a b. ConvertibleStrings a b => a -> b
cs forall a b. (a -> b) -> a -> b
$ String
"enumValueToControllerName failed for " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ParseErrorBundle Text Void
failed)
                        Right [SomeWord]
result -> [SomeWord]
result)
                forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    in
        Bool -> [SomeWord] -> Text
Inflector.camelizeCustom Bool
True [SomeWord]
words

-- | Transforms a camel case model name to a underscored table name.
--
-- >>> modelNameToTableName "User"
-- "users"
--
-- >>> modelNameToTableName "UserProject"
-- "user_projects"
modelNameToTableName :: Text -> Text
modelNameToTableName :: Text -> Text
modelNameToTableName Text
modelName =
        Text -> Either (ParseErrorBundle Text Void) Text
Inflector.toUnderscore Text
modelName
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> forall {a} {a} {b}. (Show a, Show a) => a -> Either a b -> b
unwrapEither Text
modelName
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
pluralize
{-# INLINABLE modelNameToTableName #-}

-- | Transforms a underscore table column name to a camel case attribute name for use in haskell.
--
-- >>> columnNameToFieldName "email"
-- "email"
--
-- >>> columnNameToFieldName "project_id"
-- "projectId"
columnNameToFieldName :: Text -> Text
columnNameToFieldName :: Text -> Text
columnNameToFieldName Text
columnName = Text -> Text
escapeHaskellKeyword (forall {a} {a} {b}. (Show a, Show a) => a -> Either a b -> b
unwrapEither Text
columnName forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Either (ParseErrorBundle Text Void) Text
Inflector.toCamelCased Bool
False Text
columnName)
{-# INLINABLE columnNameToFieldName #-}

{-# INLINABLE unwrapEither #-}
unwrapEither :: a -> Either a b -> b
unwrapEither a
_ (Right b
value) = b
value
unwrapEither a
input (Left a
value) = forall a. HasCallStack => String -> a
error (String
"IHP.NameSupport: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
value forall a. Semigroup a => a -> a -> a
<> String
" (value to be transformed: " forall a. Semigroup a => a -> a -> a
<>  forall a. Show a => a -> String
show a
input forall a. Semigroup a => a -> a -> a
<> String
")")

-- | Transforms a camel case attribute name from haskell to a underscore table column name for the database.
--
-- >>> fieldNameToColumnName "email"
-- "email"
--
-- >>> fieldNameToColumnName "projectId"
-- "project_id"
fieldNameToColumnName :: Text -> Text
fieldNameToColumnName :: Text -> Text
fieldNameToColumnName Text
columnName = forall {a} {a} {b}. (Show a, Show a) => a -> Either a b -> b
unwrapEither Text
columnName forall a b. (a -> b) -> a -> b
$ Text -> Either (ParseErrorBundle Text Void) Text
Inflector.toUnderscore Text
columnName
{-# INLINABLE fieldNameToColumnName #-}

-- | Returns a more friendly version for an identifier
humanize :: Text -> Text
humanize :: Text -> Text
humanize Text
text = forall {a} {a} {b}. (Show a, Show a) => a -> Either a b -> b
unwrapEither Text
text forall a b. (a -> b) -> a -> b
$ Bool -> Text -> Either (ParseErrorBundle Text Void) Text
Inflector.toHumanized Bool
True Text
text
{-# INLINABLE humanize #-}

{-# INLINABLE applyFirst #-}
applyFirst :: (Text -> Text) -> Text -> Text
applyFirst :: (Text -> Text) -> Text -> Text
applyFirst Text -> Text
f Text
text =
    let (Text
first, Text
rest) = Int -> Text -> (Text, Text)
splitAt Int
1 Text
text
    in (Text -> Text
f Text
first) forall a. Semigroup a => a -> a -> a
<> Text
rest

-- | Make a text's first character lowercase
--
-- >>> lcfirst "Hello World"
-- "hello World"
--
-- >>> lcfirst "alread lowercase"
-- "already lowercase"
lcfirst :: Text -> Text
lcfirst :: Text -> Text
lcfirst = (Text -> Text) -> Text -> Text
applyFirst Text -> Text
toLower
{-# INLINABLE lcfirst #-}

-- | Make a text's first character uppercase
--
-- >>> ucfirst "hello world"
-- "Hello World"
--
-- >>> ucfirst "Already uppercase"
-- "Already uppercase"
ucfirst :: Text -> Text
ucfirst :: Text -> Text
ucfirst = (Text -> Text) -> Text -> Text
applyFirst Text -> Text
toUpper
{-# INLINABLE ucfirst #-}

-- | Add '_' to the end of a name if it is a reserved haskell keyword
--
-- >>> escapeHaskellKeyword "test"
-- "test"
--
-- >>> escapeHaskellKeyword "type"
-- "type_"
escapeHaskellKeyword :: Text -> Text
escapeHaskellKeyword :: Text -> Text
escapeHaskellKeyword Text
name = if Text -> Text
toLower Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Text]
haskellKeywords then Text
name forall a. Semigroup a => a -> a -> a
<> Text
"_" else Text
name

haskellKeywords :: [Text]
haskellKeywords :: [Text]
haskellKeywords = [ Text
"_"
    , Text
"as"
    , Text
"case"
    , Text
"class"
    , Text
"data"
    , Text
"default"
    , Text
"deriving"
    , Text
"do"
    , Text
"else"
    , Text
"hiding"
    , Text
"if"
    , Text
"import"
    , Text
"in"
    , Text
"infix"
    , Text
"infixl"
    , Text
"infixr"
    , Text
"instance"
    , Text
"let"
    , Text
"module"
    , Text
"newtype"
    , Text
"of"
    , Text
"qualified"
    , Text
"then"
    , Text
"type"
    , Text
"where"
    , Text
"forall"
    , Text
"mdo"
    , Text
"family"
    , Text
"role"
    , Text
"pattern"
    , Text
"static"
    , Text
"group"
    , Text
"by"
    , Text
"using"
    , Text
"foreign"
    , Text
"export"
    , Text
"label"
    , Text
"dynamic"
    , Text
"safe"
    , Text
"interruptible"
    , Text
"unsafe"
    , Text
"stdcall"
    , Text
"ccall"
    , Text
"capi"
    , Text
"prim"
    , Text
"javascript"
    , Text
"rec"
    , Text
"proc"
    ]

-- | Transforms a string to a value to be safely used in urls
--
-- >>> toSlug "IHP Release: 21.08.2020 (v21082020)"
-- "ihp-release-21-08-2020-v21082020"
--
-- >>> toSlug "Hallo! @ Welt"
-- "hallo-welt"
toSlug :: Text -> Text
toSlug :: Text -> Text
toSlug Text
text =
        Text
text
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> Text
toLower
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> (Char -> Char) -> Text -> Text
map Char -> Char
replaceChar
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> [Text]
words
        forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> [Text] -> Text
intercalate Text
"-"
    where
        replaceChar :: Char -> Char
replaceChar Char
'ä' = Char
'a'
        replaceChar Char
'ö' = Char
'o'
        replaceChar Char
'ü' = Char
'u'
        replaceChar Char
char = if Char -> Bool
Char.isAlphaNum Char
char Bool -> Bool -> Bool
&& Char -> Bool
Char.isAscii Char
char then Char
char else Char
' '


-- | Transform a data-field name like @userName@  to a friendly human-readable name like @User name@
--
-- >>> fieldNameToFieldLabel "userName"
-- "User name"
--
fieldNameToFieldLabel :: Text -> Text
fieldNameToFieldLabel :: Text -> Text
fieldNameToFieldLabel Text
fieldName = forall a b. ConvertibleStrings a b => a -> b
cs (let (Right [SomeWord]
parts) = forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym)
-> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
Text.Inflections.parseCamelCase [] Text
fieldName in [SomeWord] -> Text
Text.Inflections.titleize [SomeWord]
parts)
{-# INLINABLE fieldNameToFieldLabel #-}

-- | Transform a column name like @user_name@  to a friendly human-readable name like @User name@
--
-- >>> columnNameToFieldLabel "user_name"
-- "User name"
--
columnNameToFieldLabel :: Text -> Text
columnNameToFieldLabel :: Text -> Text
columnNameToFieldLabel Text
columnName = forall a b. ConvertibleStrings a b => a -> b
cs (let (Right [SomeWord]
parts) = forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym)
-> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
Text.Inflections.parseSnakeCase [] Text
columnName in [SomeWord] -> Text
Text.Inflections.titleize [SomeWord]
parts)
{-# INLINABLE columnNameToFieldLabel #-}


-- | Removes @ Id@  from a string
--
-- >>> removeIdSuffix "User Id"
-- "User"
--
-- When the string does not end with @ Id@, it will just return the input string:
--
-- >>> removeIdSuffix "Project"
-- "Project"
removeIdSuffix :: Text -> Text
removeIdSuffix :: Text -> Text
removeIdSuffix Text
text = forall a. a -> Maybe a -> a
Maybe.fromMaybe Text
text (Text -> Text -> Maybe Text
Text.stripSuffix Text
" Id" Text
text)
{-# INLINABLE removeIdSuffix #-}