-- |
-- Module      :  Text.Inflections.Parse.CamelCase
-- Copyright   :  © 2016 Justin Leitgeb
-- License     :  MIT
--
-- Maintainer  :  Justin Leitgeb <justin@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Parser for camel case “symbols”.

{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}

module Text.Inflections.Parse.CamelCase
  ( parseCamelCase )
where

# if MIN_VERSION_base(4,8,0)
import Control.Applicative (empty, many, (<|>))
#else
import Control.Applicative (empty, many, (<|>), (<$>), (<*))
#endif
import Data.Text (Text)
import Data.Void (Void)
import Text.Inflections.Types
import Text.Megaparsec (Parsec, ParseErrorBundle, choice, eof, parse)
import Text.Megaparsec.Char
import qualified Data.Text as T

#if MIN_VERSION_base(4,8,0)
import Prelude hiding (Word)
#else
import Data.Foldable
import Prelude hiding (elem)
#endif

type Parser = Parsec Void Text

-- | Parse a CamelCase string.
--
-- >>> bar <- mkAcronym "bar"
-- >>> parseCamelCase [bar] "FooBarBazz"
-- Right [Word "Foo",Acronym "Bar",Word "Bazz"]
--
-- >>> parseCamelCase [] "foo_bar_bazz"
-- 1:4:
-- unexpected '_'
-- expecting end of input, lowercase letter, or uppercase letter
parseCamelCase :: (Foldable f, Functor f)
  => f (Word 'Acronym) -- ^ Collection of acronyms
  -> Text              -- ^ Input
  -> Either (ParseErrorBundle Text Void) [SomeWord] -- ^ Result of parsing
parseCamelCase :: forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym)
-> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
parseCamelCase f (Word 'Acronym)
acronyms = forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym) -> Parser [SomeWord]
parser f (Word 'Acronym)
acronyms) String
""

parser :: (Foldable f, Functor f)
  => f (Word 'Acronym) -- ^ Collection of acronyms
  -> Parser [SomeWord] -- ^ CamelCase parser
parser :: forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym) -> Parser [SomeWord]
parser f (Word 'Acronym)
acronyms = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Void Text Identity SomeWord
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity SomeWord
n) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  where
    n :: ParsecT Void Text Identity SomeWord
n = forall (t :: WordType).
(Transformable (Word t), Show (Word t)) =>
Word t -> SomeWord
SomeWord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Word 'Normal)
word
    a :: ParsecT Void Text Identity SomeWord
a = forall (t :: WordType).
(Transformable (Word t), Show (Word t)) =>
Word t -> SomeWord
SomeWord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym) -> Parser (Word 'Acronym)
acronym f (Word 'Acronym)
acronyms

acronym :: (Foldable f, Functor f)
  => f (Word 'Acronym)
  -> Parser (Word 'Acronym)
acronym :: forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym) -> Parser (Word 'Acronym)
acronym f (Word 'Acronym)
acronyms = do
  Text
x <- forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: WordType). Word t -> Text
unWord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Word 'Acronym)
acronyms)
  case forall (m :: * -> *). MonadThrow m => Text -> m (Word 'Acronym)
mkAcronym Text
x of
    Maybe (Word 'Acronym)
Nothing -> forall (f :: * -> *) a. Alternative f => f a
empty -- cannot happen if the system is sound
    Just Word 'Acronym
acr -> forall (m :: * -> *) a. Monad m => a -> m a
return Word 'Acronym
acr
{-# INLINE acronym #-}

word :: Parser (Word 'Normal)
word :: Parser (Word 'Normal)
word = do
  Char
firstChar <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
  String
restChars <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
  case (forall (m :: * -> *). MonadThrow m => Text -> m (Word 'Normal)
mkWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Char
firstChar forall a. a -> [a] -> [a]
: String
restChars) of
    Maybe (Word 'Normal)
Nothing -> forall (f :: * -> *) a. Alternative f => f a
empty -- cannot happen if the system is sound
    Just Word 'Normal
wrd -> forall (m :: * -> *) a. Monad m => a -> m a
return Word 'Normal
wrd
{-# INLINE word #-}