{-# LANGUAGE OverloadedStrings #-}

module Language.Ginger.Lipsum
where

import Data.Text (Text)
import qualified Data.Text as Text
import Control.Monad.Random (MonadRandom, getRandomR)
import Control.Monad (replicateM)

availableWords :: [Text]
availableWords :: [Text]
availableWords =
  [ Text
"a"
  , Text
"ab"
  , Text
"accusamus"
  , Text
"accusantium"
  , Text
"ad"
  , Text
"adipiscing"
  , Text
"alias"
  , Text
"aliquam"
  , Text
"aliquid"
  , Text
"amet"
  , Text
"animi"
  , Text
"aperiam"
  , Text
"architecto"
  , Text
"asperiores"
  , Text
"aspernatur"
  , Text
"assumenda"
  , Text
"at"
  , Text
"atque"
  , Text
"aut"
  , Text
"autem"
  , Text
"beatae"
  , Text
"blanditiis"
  , Text
"commodi"
  , Text
"consectetur"
  , Text
"consequatur"
  , Text
"consequuntur"
  , Text
"corporis"
  , Text
"corrupti"
  , Text
"culpa"
  , Text
"cum"
  , Text
"cumque"
  , Text
"cupiditate"
  , Text
"debitis"
  , Text
"delectus"
  , Text
"deleniti"
  , Text
"deserunt"
  , Text
"dicta"
  , Text
"dignissimos"
  , Text
"distinctio"
  , Text
"do"
  , Text
"dolor"
  , Text
"dolore"
  , Text
"dolorem"
  , Text
"doloremque"
  , Text
"dolores"
  , Text
"doloribus"
  , Text
"dolorum"
  , Text
"dquis"
  , Text
"ducimus"
  , Text
"ea"
  , Text
"eaque"
  , Text
"earum"
  , Text
"eius"
  , Text
"eligendi"
  , Text
"enim"
  , Text
"eos"
  , Text
"error"
  , Text
"ert"
  , Text
"esse"
  , Text
"est"
  , Text
"et"
  , Text
"eum"
  , Text
"eveniet"
  , Text
"ex"
  , Text
"excepturi"
  , Text
"exercitationem"
  , Text
"expedita"
  , Text
"explicabo"
  , Text
"facere"
  , Text
"facilis"
  , Text
"fuga"
  , Text
"fugiat"
  , Text
"fugit"
  , Text
"harum"
  , Text
"hic"
  , Text
"id"
  , Text
"illo"
  , Text
"illum"
  , Text
"impedit"
  , Text
"in"
  , Text
"incididunt"
  , Text
"inventore"
  , Text
"ipsa"
  , Text
"ipsam"
  , Text
"ipsum"
  , Text
"irure"
  , Text
"iste"
  , Text
"itaque"
  , Text
"iusto"
  , Text
"labore"
  , Text
"laboriosam"
  , Text
"laborum"
  , Text
"laudantium"
  , Text
"libero"
  , Text
"magnam"
  , Text
"magni"
  , Text
"maiores"
  , Text
"maxime"
  , Text
"minima"
  , Text
"minus"
  , Text
"modi"
  , Text
"molestiae"
  , Text
"molestias"
  , Text
"mollitia"
  , Text
"nam"
  , Text
"natus"
  , Text
"necessitatibus"
  , Text
"nemo"
  , Text
"neque"
  , Text
"nesciunt"
  , Text
"nihil"
  , Text
"nisi"
  , Text
"nobis"
  , Text
"non"
  , Text
"nostrumd"
  , Text
"nulla"
  , Text
"numquam"
  , Text
"obcaecati"
  , Text
"odio"
  , Text
"odit"
  , Text
"officia"
  , Text
"officiis"
  , Text
"omnis"
  , Text
"optio"
  , Text
"pariatur"
  , Text
"perferendis"
  , Text
"perspiciatis"
  , Text
"placeat"
  , Text
"porro"
  , Text
"possimus"
  , Text
"praesentium"
  , Text
"provident"
  , Text
"quae"
  , Text
"quaerat"
  , Text
"quam"
  , Text
"quas"
  , Text
"quasi"
  , Text
"qui"
  , Text
"quia"
  , Text
"quibusdam"
  , Text
"quidem"
  , Text
"quis"
  , Text
"quisquam"
  , Text
"quo"
  , Text
"quod"
  , Text
"quos"
  , Text
"ratione"
  , Text
"recusandae"
  , Text
"reiciendis"
  , Text
"rem"
  , Text
"repellat"
  , Text
"repellendaus"
  , Text
"reprehenderit"
  , Text
"repudiandae"
  , Text
"rerudum"
  , Text
"rerum"
  , Text
"saepe"
  , Text
"sapiente"
  , Text
"sed"
  , Text
"sequi"
  , Text
"similique"
  , Text
"sint"
  , Text
"sit"
  , Text
"soluta"
  , Text
"sunt"
  , Text
"suscipit"
  , Text
"tempora"
  , Text
"tempore"
  , Text
"temporibus"
  , Text
"tenetur"
  , Text
"totam"
  , Text
"ullam"
  , Text
"unde"
  , Text
"ut"
  , Text
"vel"
  , Text
"velit"
  , Text
"veniam"
  , Text
"veritatis"
  , Text
"vero"
  , Text
"vitae"
  , Text
"voluptas"
  , Text
"voluptate"
  , Text
"voluptatem"
  , Text
"voluptates"
  , Text
"voluptatibus"
  , Text
"voluptatum"
  ]

numWords :: Int
numWords :: Int
numWords = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
availableWords

lipsumM :: MonadRandom m => Int -> Int -> Int -> m Text
lipsumM :: forall (m :: * -> *). MonadRandom m => Int -> Int -> Int -> m Text
lipsumM Int
n Int
minWords Int
maxWords =
  [Text] -> Text
Text.unlines ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Int -> m [Text]
forall (m :: * -> *).
MonadRandom m =>
Int -> Int -> Int -> m [Text]
lipsumParasM Int
n Int
minWords Int
maxWords

lipsumParasM :: MonadRandom m => Int -> Int -> Int -> m [Text]
lipsumParasM :: forall (m :: * -> *).
MonadRandom m =>
Int -> Int -> Int -> m [Text]
lipsumParasM Int
n Int
minWords Int
maxWords =
  Int -> m Text -> m [Text]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Int -> Int -> m Text
forall (m :: * -> *). MonadRandom m => Int -> Int -> m Text
lipsumParaM Int
minWords Int
maxWords)

lipsumParaM  :: MonadRandom m => Int -> Int -> m Text
lipsumParaM :: forall (m :: * -> *). MonadRandom m => Int -> Int -> m Text
lipsumParaM Int
minWords Int
maxWords = do
  n <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minWords Int
0, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
maxWords Int
0)
  Text.unwords <$> lipsumSentencesM n

lipsumSentencesM  :: MonadRandom m => Int -> m [Text]
lipsumSentencesM :: forall (m :: * -> *). MonadRandom m => Int -> m [Text]
lipsumSentencesM Int
maxWords
  | Int
maxWords Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
  = [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  | Bool
otherwise
  = do
      n <- Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
maxWords Int
1) (Int -> Int) -> m Int -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
1, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
maxWords Int
1)
      s <- lipsumSentenceM n
      let maxWords' = Int
maxWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
      (s:) <$> lipsumSentencesM maxWords'

insertCommas :: MonadRandom m => Int -> [Text] -> m [Text]
insertCommas :: forall (m :: * -> *). MonadRandom m => Int -> [Text] -> m [Text]
insertCommas Int
percentile (Text
w:[Text]
ws) = do
  let l :: Int
l = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ws
  ws' <- (Text -> m Text) -> [Text] -> m [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
          (\Text
x -> do
            shouldInsert <- (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
percentile) (Int -> Bool) -> m Int -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
0, Int
99)
            pure $ if shouldInsert then x <> "," else x
          )
          (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
ws)
  pure $ w : ws' ++ drop (l - 1) ws
insertCommas Int
_ [Text]
ws = [Text] -> m [Text]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
ws

lipsumSentenceM  :: MonadRandom m => Int -> m Text
lipsumSentenceM :: forall (m :: * -> *). MonadRandom m => Int -> m Text
lipsumSentenceM Int
n = do
  txt <- [Text] -> Text
Text.unwords ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> m [Text]
forall (m :: * -> *). MonadRandom m => Int -> m [Text]
lipsumWordsM Int
n m [Text] -> ([Text] -> m [Text]) -> m [Text]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> [Text] -> m [Text]
forall (m :: * -> *). MonadRandom m => Int -> [Text] -> m [Text]
insertCommas Int
10)
  pure $
    Text.toUpper (Text.take 1 txt) <> Text.drop 1 txt <> "."

lipsumWordsM :: MonadRandom m => Int -> m [Text]
lipsumWordsM :: forall (m :: * -> *). MonadRandom m => Int -> m [Text]
lipsumWordsM Int
n = Int -> m Text -> m [Text]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n m Text
forall (m :: * -> *). MonadRandom m => m Text
lipsumWordM

lipsumWordM :: MonadRandom m => m Text
lipsumWordM :: forall (m :: * -> *). MonadRandom m => m Text
lipsumWordM = do
  pick <- (Int, Int) -> m Int
forall a. Random a => (a, a) -> m a
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
0, Int
numWords Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  pure $ availableWords !! pick