module Cases
(
process,
CaseTransformer,
lower,
upper,
title,
Delimiter,
spinal,
snake,
whitespace,
camel,
spinalize,
snakify,
camelize,
)
where
import Cases.Prelude hiding (Word)
import qualified Data.Attoparsec.Text as A
import qualified Data.Text as T
data Part =
Word Case T.Text |
Digits T.Text
data Case = Title | Upper | Lower
partToText :: Part -> T.Text
partToText :: Part -> Text
partToText = \case
Word Case
_ Text
t -> Text
t
Digits Text
t -> Text
t
upperParser :: A.Parser Part
upperParser :: Parser Part
upperParser = Case -> Text -> Part
Word Case
Upper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Text Char
char where
char :: Parser Text Char
char = do
Char
c <- (Char -> Bool) -> Parser Text Char
A.satisfy Char -> Bool
isUpper
Bool
ok <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Bool
isLower) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Char)
A.peekChar
if Bool
ok
then forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
else forall (f :: * -> *) a. Alternative f => f a
empty
lowerParser :: A.Parser Part
lowerParser :: Parser Part
lowerParser = Case -> Text -> Part
Word Case
Lower forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> Parser Text
A.takeWhile1 Char -> Bool
isLower)
titleParser :: A.Parser Part
titleParser :: Parser Part
titleParser = Case -> Text -> Part
Word Case
Title forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Text -> Text
T.cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char
headChar forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text
remainder) where
headChar :: Parser Text Char
headChar = (Char -> Bool) -> Parser Text Char
A.satisfy Char -> Bool
isUpper
remainder :: Parser Text
remainder = (Char -> Bool) -> Parser Text
A.takeWhile1 Char -> Bool
isLower
digitsParser :: A.Parser Part
digitsParser :: Parser Part
digitsParser = Text -> Part
Digits forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> Parser Text
A.takeWhile1 Char -> Bool
isDigit)
partParser :: A.Parser Part
partParser :: Parser Part
partParser = Parser Part
titleParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Part
upperParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Part
lowerParser forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Part
digitsParser
partsParser :: Monoid r => Folder r -> A.Parser r
partsParser :: forall r. Monoid r => Folder r -> Parser r
partsParser Folder r
fold = r -> Parser Text r
loop forall a. Monoid a => a
mempty where
loop :: r -> Parser Text r
loop r
r =
(Parser Part
partParser forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= r -> Parser Text r
loop forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Folder r
fold r
r) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Parser Text Char
A.anyChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> Parser Text r
loop r
r) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(forall t. Chunk t => Parser t ()
A.endOfInput forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure r
r)
type Folder r = r -> Part -> r
type Delimiter = Folder (Maybe T.Text)
spinal :: Delimiter
spinal :: Delimiter
spinal =
(forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Part -> Text
partToText) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\Text
l Text
r -> Text
l forall a. Semigroup a => a -> a -> a
<> Text
"-" forall a. Semigroup a => a -> a -> a
<> Text
r)
snake :: Delimiter
snake :: Delimiter
snake =
(forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Part -> Text
partToText) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\Text
l Text
r -> Text
l forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> Text
r)
whitespace :: Delimiter
whitespace :: Delimiter
whitespace =
(forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Part -> Text
partToText) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\Text
l Text
r -> Text
l forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
r)
camel :: Delimiter
camel :: Delimiter
camel =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Part -> Text
partToText (\Text
l Part
r -> Text
l forall a. Semigroup a => a -> a -> a
<> Part -> Text
partToText (CaseTransformer
title Part
r))
type CaseTransformer = Part -> Part
lower :: CaseTransformer
lower :: CaseTransformer
lower = \case
Word Case
c Text
t -> Case -> Text -> Part
Word Case
Lower Text
t' where
t' :: Text
t' = case Case
c of
Case
Title -> Text -> Maybe (Char, Text)
T.uncons Text
t forall a b. a -> (a -> b) -> b
|> \case
Maybe (Char, Text)
Nothing -> Text
t
Just (Char
h, Text
t) -> Char -> Text -> Text
T.cons (Char -> Char
toLower Char
h) Text
t
Case
Upper -> Text -> Text
T.toLower Text
t
Case
Lower -> Text
t
Part
p -> Part
p
upper :: CaseTransformer
upper :: CaseTransformer
upper = \case
Word Case
c Text
t -> Case -> Text -> Part
Word Case
Upper Text
t' where
t' :: Text
t' = case Case
c of
Case
Title -> Text -> Maybe (Char, Text)
T.uncons Text
t forall a b. a -> (a -> b) -> b
|> \case
Maybe (Char, Text)
Nothing -> Text
t
Just (Char
h, Text
t) -> Char -> Text -> Text
T.cons Char
h (Text -> Text
T.toUpper Text
t)
Case
Upper -> Text
t
Case
Lower -> Text -> Text
T.toUpper Text
t
Part
p -> Part
p
title :: CaseTransformer
title :: CaseTransformer
title = \case
Word Case
c Text
t -> Case -> Text -> Part
Word Case
Title Text
t' where
t' :: Text
t' = case Case
c of
Case
Title -> Text
t
Case
Upper -> Text -> Maybe (Char, Text)
T.uncons Text
t forall a b. a -> (a -> b) -> b
|> \case
Maybe (Char, Text)
Nothing -> Text
t
Just (Char
h, Text
t) -> Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
h) (Text -> Text
T.toLower Text
t)
Case
Lower -> Text -> Maybe (Char, Text)
T.uncons Text
t forall a b. a -> (a -> b) -> b
|> \case
Maybe (Char, Text)
Nothing -> Text
t
Just (Char
h, Text
t) -> Char -> Text -> Text
T.cons (Char -> Char
toUpper Char
h) Text
t
Part
p -> Part
p
process :: CaseTransformer -> Delimiter -> T.Text -> T.Text
process :: CaseTransformer -> Delimiter -> Text -> Text
process CaseTransformer
tr Delimiter
fo =
forall a. a -> Maybe a -> a
fromMaybe Text
"" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Char]
"Parse failure: " forall a. Semigroup a => a -> a -> a
<>)) forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall a. Parser a -> Text -> Either [Char] a
A.parseOnly (forall r. Monoid r => Folder r -> Parser r
partsParser forall a b. (a -> b) -> a -> b
$ (forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CaseTransformer
tr) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Delimiter
fo)
spinalize :: T.Text -> T.Text
spinalize :: Text -> Text
spinalize = CaseTransformer -> Delimiter -> Text -> Text
process CaseTransformer
lower Delimiter
spinal
snakify :: T.Text -> T.Text
snakify :: Text -> Text
snakify = CaseTransformer -> Delimiter -> Text -> Text
process CaseTransformer
lower Delimiter
snake
camelize :: T.Text -> T.Text
camelize :: Text -> Text
camelize = CaseTransformer -> Delimiter -> Text -> Text
process forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Delimiter
camel