module Cases
  ( -- * Processor
    process,

    -- ** Case Transformers
    CaseTransformer,
    lower,
    upper,
    title,

    -- ** Delimiters
    Delimiter,
    spinal,
    snake,
    whitespace,
    camel,

    -- * Default Processors
    spinalize,
    snakify,
    camelize,
  )
where

import Cases.Prelude hiding (Word)
import qualified Data.Attoparsec.Text as A
import qualified Data.Text as T

-- * Part

-- | A parsed info and a text of a part.
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

-- * Parsers

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

-- |
-- A parser, which does in-place processing, using the supplied 'Folder'.
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)

-- * Folders

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))

-- * CaseTransformers

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

-- * API

-- |
-- Extract separate words from an arbitrary text using a smart parser and
-- produce a new text using case transformation and delimiter functions.
--
-- Note: to skip case transformation use the 'id' function.
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)

-- |
-- Transform an arbitrary text into a lower spinal case.
--
-- Same as @('process' 'lower' 'spinal')@.
spinalize :: T.Text -> T.Text
spinalize :: Text -> Text
spinalize = CaseTransformer -> Delimiter -> Text -> Text
process CaseTransformer
lower Delimiter
spinal

-- |
-- Transform an arbitrary text into a lower snake case.
--
-- Same as @('process' 'lower' 'snake')@.
snakify :: T.Text -> T.Text
snakify :: Text -> Text
snakify = CaseTransformer -> Delimiter -> Text -> Text
process CaseTransformer
lower Delimiter
snake

-- |
-- Transform an arbitrary text into a camel case,
-- while preserving the case of the first character.
--
-- Same as @('process' 'id' 'camel')@.
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