module Parse (
DocTest(..)
, Interaction(..)
, getDocTests
, parse
) where
import Data.Char (isSpace)
import Data.List
import Data.Maybe (fromMaybe)
import Extract
data DocTest = DocExample {
moduleName :: String
, interactions :: [Interaction]
} deriving (Eq, Show)
data Interaction = Interaction {
expression :: String
, result :: [String]
} deriving (Eq, Show)
getDocTests :: [String]
-> [String]
-> IO [DocTest]
getDocTests flags modules = do
mods <- extract flags modules
return (concatMap moduleToDocTest mods)
moduleToDocTest :: Module -> [DocTest]
moduleToDocTest (Module name docs) = (map (DocExample name) . filter (not . null) . map parse) docs
parse :: String -> [Interaction]
parse input = go (map (reverse . dropWhile ((==) '\r') . reverse) $ lines input)
where
isPrompt = isPrefixOf ">>>" . dropWhile isSpace
isBlankLine = null . dropWhile isSpace
isEndOfInteraction x = isPrompt x || isBlankLine x
go :: [String] -> [Interaction]
go xs =
case dropWhile (not . isPrompt) xs of
prompt:rest ->
let
(ys,zs) = break isEndOfInteraction rest
in
toInteraction prompt ys : go zs
_ -> []
toInteraction :: String -> [String] -> Interaction
toInteraction x xs =
Interaction
(strip $ drop 3 e)
result_
where
(prefix, e) = span isSpace x
result_ = map (substituteBlankLine . tryStripPrefix prefix) xs
where
tryStripPrefix pre ys = fromMaybe ys $ stripPrefix pre ys
substituteBlankLine "<BLANKLINE>" = ""
substituteBlankLine line = line
strip :: String -> String
strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse