module Data.Owoify.Owoify
  ( owoify
  , OwoifyLevel(..)
  )
  where

import Prelude hiding (words)

import Data.Functor ((<&>))
import Data.Text.Lazy (Text, intercalate, pack)
import Text.RE.PCRE.Text.Lazy ((*=~), compileRegex, Matches, matches, RE)
import Data.Owoify.Internal.Parser.OwoifyParser (count, OError, OwoifyParser, runParser)
import Data.Owoify.Internal.Data.Presets (owoMappingList, specificWordMappingList, uvuMappingList, uwuMappingList)
import Data.Owoify.Internal.Entity.Word (InnerWord(InnerWord), toText)
import Data.Owoify.Internal.Util.Interleave (interleave)

-- | Levels to denote owoness.
data OwoifyLevel = Owo | Uwu | Uvu

extractWords :: MonadFail f => String -> Text -> f [Text]
extractWords :: String -> Text -> f [Text]
extractWords String
pattern Text
s =
  String -> f RE
forall (m :: * -> *).
(Functor m, Monad m, MonadFail m) =>
String -> m RE
compileRegex String
pattern f RE -> (RE -> Matches Text) -> f (Matches Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text
s Text -> RE -> Matches Text
*=~) f (Matches Text) -> (Matches Text -> [Text]) -> f [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Matches Text -> [Text]
forall a. Matches a -> [a]
matches

words :: Text -> IO [Text]
words :: Text -> IO [Text]
words = String -> Text -> IO [Text]
forall (f :: * -> *). MonadFail f => String -> Text -> f [Text]
extractWords String
"[^\\s]+"

spaces :: Text -> IO [Text]
spaces :: Text -> IO [Text]
spaces = String -> Text -> IO [Text]
forall (f :: * -> *). MonadFail f => String -> Text -> f [Text]
extractWords String
"\\s+"

-- | Owoify source text using the specified level and turn text into nonsensical babyspeaks.
--
-- Examples:
--
-- >>> owoify (Data.Text.Lazy.pack "Hello World!") Owo
-- Hewwo World
owoify :: Text -> OwoifyLevel -> IO Text
owoify :: Text -> OwoifyLevel -> IO Text
owoify Text
source OwoifyLevel
level = do
  [Text]
w <- Text -> IO [Text]
words Text
source
  [Text]
s <- Text -> IO [Text]
spaces Text
source
  let n :: Int
n = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
w
  let parsers :: OwoifyParser OError [IO InnerWord]
parsers = Int
-> [InnerWord -> IO InnerWord]
-> OwoifyParser OError [IO InnerWord]
forall (t :: * -> *) (m :: * -> *) e.
(Foldable t, Monad m, OwoifyError e) =>
Int -> t (InnerWord -> m InnerWord) -> OwoifyParser e [m InnerWord]
count Int
n ([InnerWord -> IO InnerWord] -> OwoifyParser OError [IO InnerWord])
-> [InnerWord -> IO InnerWord]
-> OwoifyParser OError [IO InnerWord]
forall a b. (a -> b) -> a -> b
$ [InnerWord -> IO InnerWord]
specificWordMappingList [InnerWord -> IO InnerWord]
-> [InnerWord -> IO InnerWord] -> [InnerWord -> IO InnerWord]
forall a. Semigroup a => a -> a -> a
<> (case OwoifyLevel
level of
        OwoifyLevel
Owo -> [InnerWord -> IO InnerWord]
owoMappingList
        OwoifyLevel
Uwu -> [InnerWord -> IO InnerWord]
uwuMappingList [InnerWord -> IO InnerWord]
-> [InnerWord -> IO InnerWord] -> [InnerWord -> IO InnerWord]
forall a. Semigroup a => a -> a -> a
<> [InnerWord -> IO InnerWord]
owoMappingList
        OwoifyLevel
Uvu -> [InnerWord -> IO InnerWord]
uvuMappingList [InnerWord -> IO InnerWord]
-> [InnerWord -> IO InnerWord] -> [InnerWord -> IO InnerWord]
forall a. Semigroup a => a -> a -> a
<> [InnerWord -> IO InnerWord]
uwuMappingList [InnerWord -> IO InnerWord]
-> [InnerWord -> IO InnerWord] -> [InnerWord -> IO InnerWord]
forall a. Semigroup a => a -> a -> a
<> [InnerWord -> IO InnerWord]
owoMappingList) :: OwoifyParser OError [IO InnerWord]
  let result :: Either OError (OwoifyResult [IO InnerWord])
result = OwoifyParser OError [IO InnerWord]
-> [Text] -> Either OError (OwoifyResult [IO InnerWord])
forall e a.
OwoifyError e =>
OwoifyParser e a -> [Text] -> Either e (OwoifyResult a)
runParser OwoifyParser OError [IO InnerWord]
parsers [Text]
w
  case Either OError (OwoifyResult [IO InnerWord])
result of
    Left OError
e -> do
      String -> IO Any
forall a. HasCallStack => String -> a
error (String -> IO Any) -> String -> IO Any
forall a b. (a -> b) -> a -> b
$ OError -> String
forall a. Show a => a -> String
show OError
e
      Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
""
    Right ([Text]
_, [IO InnerWord]
transformedWords) -> do
      [Text]
wordsList <- [IO InnerWord] -> IO [InnerWord]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO InnerWord]
transformedWords IO [InnerWord] -> ([InnerWord] -> [Text]) -> IO [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (InnerWord -> Text) -> [InnerWord] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InnerWord -> Text
toText
      let interleaved :: [Text]
interleaved = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
interleave [Text]
wordsList [Text]
s
      Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate (String -> Text
pack String
"") [Text]
interleaved