module Morley.Util.Text
( headToLower
, surround
, dquotes
, stripFieldPrefix
, dropPrefix
, toCamel
, Manip.toPascal
, toSnake
, toSpinal
, lowerCaseCluster
) where
import Data.Char (isLower, isUpper, toLower)
import Data.Text qualified as T
import Data.Text.Manipulate qualified as Manip
headToLower :: HasCallStack => Text -> Text
headToLower :: HasCallStack => Text -> Text
headToLower Text
txt = case Text -> Maybe (Char, Text)
T.uncons Text
txt of
Maybe (Char, Text)
Nothing -> Text -> Text
forall a. HasCallStack => Text -> a
error Text
"Empty text"
Just (Char
c, Text
cs) -> Char -> Text -> Text
T.cons (Char -> Char
toLower Char
c) Text
cs
surround :: Semigroup a => a -> a -> a -> a
surround :: forall a. Semigroup a => a -> a -> a -> a
surround a
pre a
post a
content = a
pre a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
content a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
post
dquotes :: (Semigroup a, IsString a) => a -> a
dquotes :: forall a. (Semigroup a, IsString a) => a -> a
dquotes = a -> a -> a -> a
forall a. Semigroup a => a -> a -> a -> a
surround a
"\"" a
"\""
dropPrefix :: Text -> Text
dropPrefix :: Text -> Text
dropPrefix = (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
forall a. Boolean a => a -> a
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isUpper)
toCamel :: Text -> Text
toCamel :: Text -> Text
toCamel = Text -> Text
Manip.toCamel (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
lowerCaseCluster
toSnake :: Text -> Text
toSnake :: Text -> Text
toSnake = Text -> [Text] -> Text
T.intercalate Text
"_" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
Manip.toSnake (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
lowerCaseCluster) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Manip.splitWords
toSpinal :: Text -> Text
toSpinal :: Text -> Text
toSpinal = Text -> [Text] -> Text
T.intercalate Text
"-" ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Text
Manip.toSpinal (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
lowerCaseCluster) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Manip.splitWords
lowerCaseCluster :: Text -> Text
lowerCaseCluster :: Text -> Text
lowerCaseCluster Text
x = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
x do
(Char
c1, Text
xs) <- Text -> Maybe (Char, Text)
T.uncons Text
x
(Char
c2, Text
_) <- Text -> Maybe (Char, Text)
T.uncons Text
xs
if Char -> Bool
notLower Char
c1 Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Char -> Bool
notLower Char
c2
then do
let (Text
ucs, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
notLower Text
x
(Text
ucs', Char
lastuc) <- Text -> Maybe (Text, Char)
T.unsnoc Text
ucs
Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> Text -> Text
T.map Char -> Char
toLower Text
ucs' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text -> Text
T.cons Char
lastuc Text
rest
else Maybe Text
forall a. Maybe a
Nothing
where
notLower :: Char -> Bool
notLower = Bool -> Bool
forall a. Boolean a => a -> a
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isLower
stripFieldPrefix :: Text -> Text
stripFieldPrefix :: Text -> Text
stripFieldPrefix = Text -> Text
toCamel (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
dropPrefix