doctest-lib 0.1 → 0.1.1
raw patch · 2 files changed
+54/−70 lines, 2 filesdep +utility-htPVP ok
version bump matches the API change (PVP)
Dependencies added: utility-ht
API changes (from Hackage documentation)
Files
- doctest-lib.cabal +3/−2
- src/Test/DocTest/Parse.hs +51/−68
doctest-lib.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: doctest-lib-Version: 0.1+Version: 0.1.1 License: MIT License-File: LICENSE Author: Henning Thielemann <haskell@henning-thielemann.de>, Simon Hengel <sol@typeful.net>@@ -15,7 +15,7 @@ Build-Type: Simple Source-Repository this- Tag: 0.1+ Tag: 0.1.1 Type: darcs Location: https://hub.darcs.net/thielema/doctest-lib/ @@ -25,6 +25,7 @@ Library Build-Depends:+ utility-ht >=0.0.14 && <0.1, base >=4.3 && <5 GHC-Options: -Wall
src/Test/DocTest/Parse.hs view
@@ -8,12 +8,16 @@ import Test.DocTest.Location (Located(Located), unLoc) import Test.DocTest.Base +import qualified Data.List.HT as ListHT import Data.List (stripPrefix, isPrefixOf)-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, isJust) import Data.Char (isSpace) +import Control.Arrow (second)+import Control.Applicative ((<$>), (<|>)) + data DocTest = Example Expression ExpectedResult | Property Expression deriving (Eq, Show) @@ -21,81 +25,65 @@ type Interaction = (Expression, ExpectedResult) -parseComment :: [Located pos String] -> [Located pos DocTest]-parseComment nLines = properties ++ examples- where- examples = map (fmap $ uncurry Example) (parseInteractions nLines)- properties = map (fmap Property) (parseProperties nLines)+data Prompt = ExamplePrompt | PropPrompt --- | Extract all properties from given Haddock comment.-parseProperties :: [Located pos String] -> [Located pos Expression]-parseProperties = go+parseComment :: [Located pos String] -> [Located pos DocTest]+parseComment = go where- isPrompt :: Located pos String -> Bool- isPrompt = isPrefixOf "prop>" . dropWhile isSpace . unLoc+ examplePrompt :: String+ examplePrompt = ">>>" - go xs = case dropWhile (not . isPrompt) xs of- prop:rest -> stripPrompt `fmap` prop : go rest- [] -> []+ propPrompt :: String+ propPrompt = "prop>" - stripPrompt = strip . drop 5 . dropWhile isSpace+ maybePrompt ::+ Located pos String -> Maybe (String, (Prompt, Located pos String))+ maybePrompt (Located loc line) =+ (\(indentation, str) ->+ fmap ((,) indentation) $+ (,) ExamplePrompt . Located loc <$> stripPrefix examplePrompt str+ <|>+ (,) PropPrompt . Located loc <$> stripPrefix propPrompt str)+ .+ span isSpace+ $ line --- | Extract all interactions from given Haddock comment.-parseInteractions :: [Located pos String] -> [Located pos Interaction]-parseInteractions = go- where- isPrompt :: Located pos String -> Bool- isPrompt = isPrefixOf ">>>" . dropWhile isSpace . unLoc+ isClosingLine :: Located pos String -> Bool+ isClosingLine = isPrefixOf ":}" . dropWhile isSpace . unLoc isBlankLine :: Located pos String -> Bool isBlankLine = null . dropWhile isSpace . unLoc isEndOfInteraction :: Located pos String -> Bool- isEndOfInteraction x = isPrompt x || isBlankLine x--- go :: [Located pos String] -> [Located pos Interaction]- go xs = case dropWhile (not . isPrompt) xs of- prompt:rest ->- case (words (drop 3 (dropWhile isSpace (unLoc prompt))),- break isBlankLine rest) of- (":{" : _, (ys,zs)) -> toInteraction prompt ys : go zs- _ ->- let (ys,zs) = break isEndOfInteraction rest- in toInteraction prompt ys : go zs- [] -> []---- | Create an `Interaction`, strip superfluous whitespace as appropriate.------ also merge lines between :{ and :}, preserving whitespace inside--- the block (since this is useful for avoiding {;}).-toInteraction :: Located pos String -> [Located pos String] -> Located pos Interaction-toInteraction (Located loc x) xs = Located loc $- (- (strip cleanedE) -- we do not care about leading and trailing- -- whitespace in expressions, so drop them- , map mkExpectedLine result_- )- where- -- 1. drop trailing whitespace from the prompt, remember the prefix- (prefix, e) = span isSpace x- (ePrompt, eRest) = splitAt 3 e-- -- 2. drop, if possible, the exact same sequence of whitespace- -- characters from each result line- unindent pre = map (tryStripPrefix pre . unLoc)+ isEndOfInteraction x = isJust (maybePrompt x) || isBlankLine x - cleanBody line = fromMaybe (unLoc line)- (stripPrefix ePrompt (dropWhile isSpace (unLoc line)))+ go xs =+ case ListHT.dropWhileNothing maybePrompt xs of+ Nothing -> []+ Just ((ind, (prompt, firstLine@(Located loc firstLineStr))), rest) ->+ let firstLineUnindented = dropWhile isSpace firstLineStr in+ case isPrefixOf ":{" firstLineUnindented of+ False -> cont prompt ind firstLine rest+ True ->+ case second (splitAt 1) $ break isClosingLine rest of+ (ys,(closing,zs)) ->+ cont prompt ind+ (Located loc $ unlines $+ firstLineUnindented : map unLoc (ys++closing))+ zs - (cleanedE, result_) =- case break ( (==) [":}"] . take 1 . words . cleanBody) xs of- (body , endLine : rest) ->- (unlines (eRest : map cleanBody body ++- [dropWhile isSpace (cleanBody endLine)]),- unindent (takeWhile isSpace (unLoc endLine)) rest)- _ -> (eRest, unindent prefix xs)+ cont prompt ind expr@(Located loc exprStr) rest =+ case prompt of+ PropPrompt -> fmap Property expr : go rest+ ExamplePrompt ->+ let (ys,zs) = break isEndOfInteraction rest+ in Located loc+ (Example exprStr $ map mkExpectedLine $ unindent ind ys)+ :+ go zs +unindent :: String -> [Located pos String] -> [String]+unindent pre = map (tryStripPrefix pre . unLoc) tryStripPrefix :: String -> String -> String tryStripPrefix prefix ys = fromMaybe ys $ stripPrefix prefix ys@@ -121,8 +109,3 @@ then (0, c : replicate count '.' ++ acc, res) else (0, c : acc, res) finish (count, acc, res) = mkChunk (replicate count '.' ++ acc) ++ res----- | Remove leading and trailing whitespace.-strip :: String -> String-strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse