module Cases
(
process,
CaseTransformer,
lower,
upper,
title,
Delimiter,
spinal,
snake,
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 = \case
Word _ t -> t
Digits t -> t
upperParser :: A.Parser Part
upperParser = Word Upper <$> T.pack <$> A.many1 char where
char = do
c <- A.satisfy isUpper
ok <- maybe True (not . isLower) <$> A.peekChar
if ok
then return c
else empty
lowerParser :: A.Parser Part
lowerParser = Word Lower <$> (A.takeWhile1 isLower)
titleParser :: A.Parser Part
titleParser = Word Title <$> (T.cons <$> headChar <*> remainder) where
headChar = A.satisfy isUpper
remainder = A.takeWhile1 isLower
digitsParser :: A.Parser Part
digitsParser = Digits <$> (A.takeWhile1 isDigit)
partParser :: A.Parser Part
partParser = titleParser <|> upperParser <|> lowerParser <|> digitsParser
partsParser :: Monoid r => Folder r -> A.Parser r
partsParser fold = loop mempty where
loop r =
(partParser >>= loop . fold r) <|>
(A.anyChar *> loop r) <|>
(A.endOfInput *> pure r)
type Folder r = r -> Part -> r
type Delimiter = Folder (Maybe T.Text)
spinal :: Delimiter
spinal =
(. partToText) .
fmap Just .
maybe id (\l r -> l <> "-" <> r)
snake :: Delimiter
snake =
(. partToText) .
fmap Just .
maybe id (\l r -> l <> "_" <> r)
camel :: Delimiter
camel =
fmap Just .
maybe partToText (\l r -> l <> partToText (title r))
type CaseTransformer = Part -> Part
lower :: CaseTransformer
lower = \case
Word c t -> Word Lower t' where
t' = case c of
Title -> T.uncons t |> \case
Nothing -> t
Just (h, t) -> T.cons (toLower h) t
Upper -> T.toLower t
Lower -> t
p -> p
upper :: CaseTransformer
upper = \case
Word c t -> Word Upper t' where
t' = case c of
Title -> T.uncons t |> \case
Nothing -> t
Just (h, t) -> T.cons h (T.toUpper t)
Upper -> t
Lower -> T.toUpper t
p -> p
title :: CaseTransformer
title = \case
Word c t -> Word Title t' where
t' = case c of
Title -> t
Upper -> T.uncons t |> \case
Nothing -> t
Just (h, t) -> T.cons (toUpper h) (T.toLower t)
Lower -> T.uncons t |> \case
Nothing -> t
Just (h, t) -> T.cons (toUpper h) t
p -> p
process :: CaseTransformer -> Delimiter -> T.Text -> T.Text
process tr fo =
fromMaybe "" .
either ($bug . ("Parse failure: " <>)) id .
A.parseOnly (partsParser $ (. tr) . fo)
spinalize :: T.Text -> T.Text
spinalize = process lower spinal
snakify :: T.Text -> T.Text
snakify = process lower snake
camelize :: T.Text -> T.Text
camelize = process id camel