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 (Text -> Part) -> (String -> Text) -> String -> Part
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text
T.pack (String -> Part) -> Parser Text String -> Parser Part
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
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 <- Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
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) (Maybe Char -> Bool)
-> Parser Text (Maybe Char) -> Parser Text Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Char)
A.peekChar
    if Bool
ok
      then Char -> Parser Text Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
      else Parser Text Char
forall (f :: * -> *) a. Alternative f => f a
empty

lowerParser :: A.Parser Part
lowerParser :: Parser Part
lowerParser = Case -> Text -> Part
Word Case
Lower (Text -> Part) -> Parser Text Text -> Parser Part
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> Parser Text Text
A.takeWhile1 Char -> Bool
isLower)

titleParser :: A.Parser Part
titleParser :: Parser Part
titleParser = Case -> Text -> Part
Word Case
Title (Text -> Part) -> Parser Text Text -> Parser Part
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Text -> Text
T.cons (Char -> Text -> Text)
-> Parser Text Char -> Parser Text (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char
headChar Parser Text (Text -> Text) -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
remainder) where
  headChar :: Parser Text Char
headChar = (Char -> Bool) -> Parser Text Char
A.satisfy Char -> Bool
isUpper
  remainder :: Parser Text Text
remainder = (Char -> Bool) -> Parser Text Text
A.takeWhile1 Char -> Bool
isLower

digitsParser :: A.Parser Part
digitsParser :: Parser Part
digitsParser = Text -> Part
Digits (Text -> Part) -> Parser Text Text -> Parser Part
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> Parser Text Text
A.takeWhile1 Char -> Bool
isDigit)

partParser :: A.Parser Part
partParser :: Parser Part
partParser = Parser Part
titleParser Parser Part -> Parser Part -> Parser Part
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Part
upperParser Parser Part -> Parser Part -> Parser Part
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Part
lowerParser Parser Part -> Parser Part -> Parser Part
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 :: Folder r -> Parser r
partsParser Folder r
fold = r -> Parser r
loop r
forall a. Monoid a => a
mempty where
  loop :: r -> Parser r
loop r
r = 
    (Parser Part
partParser Parser Part -> (Part -> Parser r) -> Parser r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= r -> Parser r
loop (r -> Parser r) -> (Part -> r) -> Part -> Parser r
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) Parser r -> Parser r -> Parser r
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
    (Parser Text Char
A.anyChar Parser Text Char -> Parser r -> Parser r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> Parser r
loop r
r) Parser r -> Parser r -> Parser r
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (Parser Text ()
forall t. Chunk t => Parser t ()
A.endOfInput Parser Text () -> Parser r -> Parser r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> Parser r
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 = 
  ((Text -> Maybe Text) -> (Part -> Text) -> Part -> Maybe Text
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) ((Text -> Maybe Text) -> Part -> Maybe Text)
-> (Maybe Text -> Text -> Maybe Text) -> Delimiter
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 
  (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just ((Text -> Text) -> Text -> Maybe Text)
-> (Maybe Text -> Text -> Text) -> Maybe Text -> Text -> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 
  (Text -> Text)
-> (Text -> Text -> Text) -> Maybe Text -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\Text
l Text
r -> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r)

snake :: Delimiter
snake :: Delimiter
snake = 
  ((Text -> Maybe Text) -> (Part -> Text) -> Part -> Maybe Text
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) ((Text -> Maybe Text) -> Part -> Maybe Text)
-> (Maybe Text -> Text -> Maybe Text) -> Delimiter
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 
  (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just ((Text -> Text) -> Text -> Maybe Text)
-> (Maybe Text -> Text -> Text) -> Maybe Text -> Text -> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 
  (Text -> Text)
-> (Text -> Text -> Text) -> Maybe Text -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\Text
l Text
r -> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r)

whitespace :: Delimiter
whitespace :: Delimiter
whitespace = 
  ((Text -> Maybe Text) -> (Part -> Text) -> Part -> Maybe Text
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) ((Text -> Maybe Text) -> Part -> Maybe Text)
-> (Maybe Text -> Text -> Maybe Text) -> Delimiter
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 
  (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just ((Text -> Text) -> Text -> Maybe Text)
-> (Maybe Text -> Text -> Text) -> Maybe Text -> Text -> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 
  (Text -> Text)
-> (Text -> Text -> Text) -> Maybe Text -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (\Text
l Text
r -> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r)

camel :: Delimiter
camel :: Delimiter
camel = 
  (Text -> Maybe Text) -> (Part -> Text) -> Part -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just ((Part -> Text) -> Part -> Maybe Text)
-> (Maybe Text -> Part -> Text) -> Delimiter
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
  (Part -> Text)
-> (Text -> Part -> Text) -> Maybe Text -> Part -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Part -> Text
partToText (\Text
l Part
r -> Text
l Text -> Text -> Text
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 Maybe (Char, Text) -> (Maybe (Char, Text) -> Text) -> Text
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 Maybe (Char, Text) -> (Maybe (Char, Text) -> Text) -> Text
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 Maybe (Char, Text) -> (Maybe (Char, Text) -> Text) -> Text
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 Maybe (Char, Text) -> (Maybe (Char, Text) -> Text) -> Text
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 = 
  Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> (Text -> Maybe Text) -> Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
  (String -> Maybe Text)
-> (Maybe Text -> Maybe Text)
-> Either String (Maybe Text)
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Maybe Text
forall a. HasCallStack => String -> a
error (String -> Maybe Text)
-> (String -> String) -> String -> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String
"Parse failure: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)) Maybe Text -> Maybe Text
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (Either String (Maybe Text) -> Maybe Text)
-> (Text -> Either String (Maybe Text)) -> Text -> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
  Parser (Maybe Text) -> Text -> Either String (Maybe Text)
forall a. Parser a -> Text -> Either String a
A.parseOnly (Delimiter -> Parser (Maybe Text)
forall r. Monoid r => Folder r -> Parser r
partsParser (Delimiter -> Parser (Maybe Text))
-> Delimiter -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ((Part -> Maybe Text) -> CaseTransformer -> Part -> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. CaseTransformer
tr) ((Part -> Maybe Text) -> Part -> Maybe Text)
-> Delimiter -> Delimiter
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 CaseTransformer
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Delimiter
camel