{-# 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
parseSnakeCase :: (Foldable f, Functor f)
=> f (Word 'Acronym)
-> Text
-> Either (ParseErrorBundle Text Void) [SomeWord]
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)