module Text.Spintax.RandomPhrase where

import           Data.Either.Combinators (mapRight)
import qualified Data.Text               as T
import           Text.Spintax

newtype RandomPhrase = RandomPhrase { RandomPhrase -> Text
unRandomPhrase :: T.Text }

instance Show RandomPhrase where
  show :: RandomPhrase -> String
show (RandomPhrase Text
t) = Text -> String
forall a. Show a => a -> String
show Text
t

-- | Generate random passphrase or unique id
--
-- >λ> randomPhrase "-" [["blacky","monk","gillespie","coltrane"],["apple","apricot","banana","coconut"],["kant","hegel","husserl","habermas"]]
-- > Right "coltrane-coconut-kant"
--
randomPhrase :: T.Text -> [[T.Text]] -> IO (Either String RandomPhrase)
randomPhrase :: Text -> [[Text]] -> IO (Either String RandomPhrase)
randomPhrase Text
s [[Text]]
ls =
  (Text -> RandomPhrase)
-> Either String Text -> Either String RandomPhrase
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight Text -> RandomPhrase
RandomPhrase (Either String Text -> Either String RandomPhrase)
-> IO (Either String Text) -> IO (Either String RandomPhrase)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO (Either String Text)
spintax (Text -> [Text] -> Text
writeSpintaxExpression Text
s ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
writeSpintaxAlternative ([Text] -> Text) -> [[Text]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Text]]
ls)