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

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

module Text.Inflections.Parse.SnakeCase
  ( parseSnakeCase )
where

# if MIN_VERSION_base(4,8,0)
import Control.Applicative (empty, some)
#else
import Control.Applicative (empty, some, (<$>), (<*))
#endif
import Data.Text (Text)
import Data.Void (Void)
import Text.Inflections.Types
import Text.Megaparsec (Parsec, ParseErrorBundle, eof, sepBy, 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 snake_case string.
--
-- >>> bar <- mkAcronym "bar"
-- >>> parseSnakeCase [bar] "foo_bar_bazz"
-- Right [Word "foo",Acronym "bar",Word "bazz"]
--
-- >>> parseSnakeCase [] "fooBarBazz"
-- 1:4:
-- unexpected 'B'
-- expecting '_', end of input, or lowercase letter
parseSnakeCase :: (Foldable f, Functor f)
  => f (Word 'Acronym) -- ^ Collection of acronyms
  -> Text              -- ^ Input
  -> Either (ParseErrorBundle Text Void) [SomeWord] -- ^ Result of parsing
parseSnakeCase :: forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym)
-> Text -> Either (ParseErrorBundle Text Void) [SomeWord]
parseSnakeCase 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)
  -> Parser [SomeWord]
parser :: forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym) -> Parser [SomeWord]
parser f (Word 'Acronym)
acronyms = (forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym) -> Parser SomeWord
pWord f (Word 'Acronym)
acronyms forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

pWord :: (Foldable f, Functor f)
  => f (Word 'Acronym)
  -> Parser SomeWord
pWord :: forall (f :: * -> *).
(Foldable f, Functor f) =>
f (Word 'Acronym) -> Parser SomeWord
pWord f (Word 'Acronym)
acronyms = do
  let acs :: f Text
acs = forall (t :: WordType). Word t -> Text
unWord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Word 'Acronym)
acronyms
  Text
r <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
some forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
  if Text
r forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` f Text
acs
    then forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: WordType).
(Transformable (Word t), Show (Word t)) =>
Word t -> SomeWord
SomeWord) (forall (m :: * -> *). MonadThrow m => Text -> m (Word 'Acronym)
mkAcronym Text
r)
    else forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: WordType).
(Transformable (Word t), Show (Word t)) =>
Word t -> SomeWord
SomeWord) (forall (m :: * -> *). MonadThrow m => Text -> m (Word 'Normal)
mkWord    Text
r)