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
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 #-}
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 #-}
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
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 #-}
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
")")
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 #-}
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
lcfirst :: Text -> Text
lcfirst :: Text -> Text
lcfirst = (Text -> Text) -> Text -> Text
applyFirst Text -> Text
toLower
{-# INLINABLE lcfirst #-}
ucfirst :: Text -> Text
ucfirst :: Text -> Text
ucfirst = (Text -> Text) -> Text -> Text
applyFirst Text -> Text
toUpper
{-# INLINABLE ucfirst #-}
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"
]
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
' '
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 #-}
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 #-}
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 #-}