module RlangQQ.ParseKnitted
(parseKnitted,
KnitInteraction(..),
KnitOutput(..)) where
import Data.List.Split hiding (chunk)
import Data.List
import Data.Maybe
import Data.Char
parseKnitted file = grp . chunk . lines $ file
data KnitInteraction = KnitInteraction String [KnitOutput]
deriving (Show)
data KnitOutput
= KnitAsIs String
| KnitPrint String
| KnitWarning String
| KnitError String
| KnitImage String FilePath
deriving (Show)
chunk ( (stripPrefix "```" -> Just x) : xs) =
let (a,b) = break (isPrefixOf "```") xs
in (x,a) : chunk b
chunk ("" : xs) = chunk xs
chunk [] = []
classify :: [String] -> [KnitOutput]
classify (x:xs) | Just r <- stripPrefix "## Warning: " x =
[KnitWarning (unlines $ r : map (tryStripPrefix "## ") xs)]
classify (x:xs) | Just r <- stripPrefix "## Error: " x =
[KnitError (unlines $ r : map (tryStripPrefix "## ") xs)]
classify xs = splitImg xs
splitImg (x:xs) | Just r <- stripPrefix "![" x =
let end s = case splitOn "](" s of
[a,b] -> Just (KnitImage a b)
_ -> Nothing
getCaps [] = []
getCaps s = mapMaybe end $ splitOn ") ![" (r ++ "![")
in getCaps r ++ splitImg xs
splitImg [] = []
splitImg xs @ (x : _) | "## " `isPrefixOf` x =
let (a,b) = span (isPrefixOf "## ") xs
in KnitPrint (unlines $ map (tryStripPrefix "## ") a) : splitImg b
splitImg xs =
let (a,b) = break (\x -> any (`isPrefixOf` x) ["![","## "]) xs
in KnitAsIs (unlines a) : splitImg b
tryStripPrefix p x = fromMaybe x $ stripPrefix p x
grp (((/= "") -> True, a) : xs) =
let (b,c) = span ((== "") . fst) xs
in KnitInteraction (unlines a) (filter notBlank $ concatMap (classify . snd) b) : grp c
grp [] = []
notBlank (KnitPrint x) = not (all isSpace x)
notBlank _ = True