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