module Text.Spintax (spintax) where
import Control.Applicative ((<|>))
import Data.Attoparsec.Text
import qualified Data.List.Extra as E
import Data.Monoid ((<>))
import qualified Data.Text as T
import System.Random.MWC
spintax :: T.Text -> IO (Either T.Text T.Text)
spintax template =
createSystemRandom >>= flip runParse template
where
runParse g' i' = go g' "" [] i' (0::Int)
where
go g o as i l
| l < 0 = failure
| l == 0 =
case parse spinSyntax i of
Done r m ->
case m of
"{" -> go g o as r (l+1)
"}" -> failure
"|" -> failure
_ -> go g (o <> m) as r l
Partial _ -> return $ Right $ o <> i
Fail {} -> failure
| l == 1 =
case parse spinSyntax i of
Done r m ->
case m of
"{" -> go g o (add as m) r (l+1)
"}" -> do r' <- runParse g =<< randAlter g as
case r' of
Left _ -> failure
Right t -> go g (o <> t) [] r (l1)
"|" -> if E.null as
then go g o ["",""] r l
else go g o (E.snoc as "") r l
_ -> go g o (add as m) r l
Partial _ -> failure
Fail {} -> failure
| l > 1 =
case parse spinSyntax i of
Done r m ->
case m of
"{" -> go g o (add as m) r (l+1)
"}" -> go g o (add as m) r (l1)
_ -> go g o (add as m) r l
Partial _ -> failure
Fail {} -> failure
where
add _l _t =
case E.unsnoc _l of
Just (xs,x) -> E.snoc xs $ x <> _t
Nothing -> [_t]
randAlter _g _as =
(\r -> (!!) as (r1)) <$> uniformR (1,E.length _as) _g
spinSyntax =
openBrace <|> closeBrace <|> pipe <|> content
where
openBrace = string "{"
closeBrace = string "}"
pipe = string "|"
content =
takeWhile1 ctt
where
ctt '{' = False
ctt '}' = False
ctt '|' = False
ctt _ = True
go _ _ _ _ _ = failure
failure :: IO (Either T.Text b)
failure = return $ Left "Spintax template parsing failure"