quantities 0.2.0 → 0.3.0

raw patch · 12 files changed

+213/−53 lines, 12 filesdep +Globdep +doctestdep +processdep ~base

Dependencies added: Glob, doctest, process, regex-compat

Dependency ranges changed: base

Files

• CHANGES.md +11/−3
• library/Data/Quantities.hs +10/−7
• library/Data/Quantities/Constructors.hs +26/−10
• library/Data/Quantities/Convert.hs +14/−7
• library/Data/Quantities/Data.hs +40/−16
• library/Data/Quantities/DefaultUnits.hs +1/−0
• library/Data/Quantities/DefinitionParser.hs +9/−2
• library/Data/Quantities/Definitions.hs +9/−0
• library/Data/Quantities/ExprParser.hs +46/−7
• quantities.cabal +15/−1
• test-suite/DocCoverage.hs +25/−0
• test-suite/DocTest.hs +7/−0

@@ -1,16 +1,24 @@ quantities changelog ==================== --0.2 (unreleased)+0.3 (4-15-2014) ---------------- +- Added unit conversion to fromString using "x => y"+- Made dimensionality printing nicer.+- Added doctests and doc coverage tests.+++0.2 (4-6-2014)+--------------+ - Can handle arithmetical expressions in fromString - Added support for user-defined definitions+- Added check that definitions are the same for conversions   0.1 (3-31-2014)-----------------+---------------  - Full implementation of multiplicative dimensional quantities (no offsets yet   for temperatures).

@@ -50,6 +50,11 @@ import Data.Quantities.Definitions (readDefinitions) import Data.Quantities.DefaultUnits (defaultDefString) ++-- $setup+-- >>> import Control.Applicative++ -- $constructors -- -- Currently, one constructor is supported to create quantities: 'fromString'.@@ -98,10 +103,9 @@ -- 'defaultDefString'. Here is an example of adding a new unit called -- @metric_foot@. ----- > myDefString = defaultDefString ++ "\n" ++ "metric_foot = 300mm"--- > (Right d') = readDefinitions myDefString--- > myFromString = fromString' d'---+-- >>> let myDefString = defaultDefString ++ "\n" ++ "metric_foot = 300mm"+-- >>> let (Right d') = readDefinitions myDefString+-- >>> let myFromString = fromString' d' -- >>> myFromString "metric_foot" -- Right 1.0 metric_foot -- >>> convertBase <$> myFromString "metric_foot"@@ -117,8 +121,7 @@ -- done when a unit is created, and not when performing conversions. We try to -- catch when different definitions are used. ----- > (Right m)  = fromString "m"--- > (Right ft) = myFromString "ft"---+-- >>> let (Right m)  = fromString "m"+-- >>> let (Right ft) = myFromString "ft" -- >>> convert m (units ft) -- Left (DifferentDefinitionsError meter foot)

@@ -1,3 +1,4 @@+-- | Defines the common constructors used to build quantities. module Data.Quantities.Constructors where  import Data.Quantities.Data@@ -5,11 +6,12 @@ import Data.Quantities.Definitions (readDefinitions) import Data.Quantities.ExprParser (parseExprQuant) +-- | Default set of definitions that come predefined. defaultDefinitions :: Either QuantityError Definitions defaultDefinitions = readDefinitions defaultDefString -d :: Definitions-(Right d) = defaultDefinitions+-- $setup+-- >>> import Data.Quantities  -- | Create a Quantity by parsing a string. Uses an 'UndefinedUnitError' for -- undefined units. Handles arithmetic expressions as well.@@ -21,22 +23,36 @@ -- >>> fromString "ft + 12in" -- Right 2.0 foot --+-- This function also supports unit conversions, by placing \"=>\" in between+-- two valid expressions. This behavior is undefined (and returns a+-- ScalingFactorError) if the quantity to be converted to has a magnitude.+--+-- >>> fromString "min => s"+-- Right 60.0 second+-- >>> fromString "2 ft + 6 in => ft"+-- Right 2.5 foot+-- >>> fromString "m => 3 ft"+-- Left (ScalingFactorError 3.0 foot)+-- -- Make sure not to use dimensional quantities in exponents. -- -- >>> fromString "m ** 2"--- Right 1.0 meter ** 2.0+-- Right 1.0 meter ** 2 -- >>> fromString "m ** (2s)" -- Left (ParserError "Used non-dimensionless exponent in ( Right 1.0 meter ) ** ( Right 2.0 second )") fromString :: String -> Either QuantityError Quantity-fromString = parseExprQuant d+fromString s = case defaultDefinitions of+                    (Right d) -> parseExprQuant d s+                    (Left d)  -> Left d + -- | Create quantities with custom definitions. ----- > (Right d) = readDefinitions myDefString--- > myFromString = fromString' d------ >>> myFromString "25 m/s"--- Right 25.0 meter / second+-- >>> let myDefString = defaultDefString ++ "\nmy_unit = 100 s"+-- >>> let (Right d) = readDefinitions myDefString+-- >>> let myFromString = fromString' d+-- >>> myFromString "25 my_unit"+-- Right 25.0 my_unit fromString' :: Definitions -> String -> Either QuantityError Quantity fromString' = parseExprQuant @@ -44,6 +60,6 @@ -- | Parse units from a string. Equivalent to @fmap units . fromString@ -- -- >>> unitsFromString "N * s"--- Right [newton,second]+-- Right newton second unitsFromString :: String -> Either QuantityError CompoundUnit unitsFromString = fmap units . fromString

@@ -1,3 +1,5 @@+-- | Module to perform unit conversions, compute dimensionality, and convert to+-- base units. module Data.Quantities.Convert where  import Data.List (sort)@@ -5,8 +7,9 @@  import Data.Quantities.Data -unityQuant :: Definitions -> Quantity-unityQuant d = Quantity 1 (CompoundUnit d [])+-- $setup+-- >>> import Control.Applicative+-- >>> import Data.Quantities  -- | Convert quantity to given units. --@@ -23,7 +26,7 @@ -- | Convert a quantity to its base units. -- -- >>> convertBase <$> fromString "newton"--- Right 1000.0 gram meter / second ** 2.0+-- Right 1000.0 gram meter / second ** 2 convertBase :: Quantity -> Quantity convertBase x = convertBase' (defs' x) x @@ -48,7 +51,8 @@  -- | Converts a composite unit to its base quantity toBase :: Definitions -> [SimpleUnit] -> Quantity-toBase d = foldr (multiplyQuants . simpleToBase d) (unityQuant d)+toBase d = foldr (multiplyQuants . simpleToBase d) unityQuant+  where unityQuant = Quantity 1 (CompoundUnit d [])   -- | Converts a simple unit to its base quantity.@@ -62,15 +66,18 @@ -- | Computes dimensionality of quantity. -- -- >>> dimensionality <$> fromString "newton"--- Right [length,mass,time ** -2.0]+-- Right [length] [mass] / [time] ** 2 dimensionality :: Quantity -> CompoundUnit dimensionality q = CompoundUnit (defs' q) dimUnits   where dimUnits = dimensionality' (defs' q) (units' q) +-- | Computes dimensionality of a list of SimpleUnits. Stores the+-- dimensionality as a list of SimpleUnits as well, so we don't need a whole+-- new type. dimensionality' :: Definitions -> [SimpleUnit] -> [SimpleUnit] dimensionality' d us = sort $ map dim ub   where ub = units' $ toBase d us-        dim (SimpleUnit sym _ pow) = SimpleUnit (unitTypes d M.! sym) "" pow+        dim (SimpleUnit sym _ pow) = SimpleUnit ('[' : unitTypes d M.! sym ++ "]") "" pow   -- | Adds two quantities. Second quantity is converted to units of@@ -84,7 +91,7 @@ subtractQuants :: Quantity -> Quantity -> Either QuantityError Quantity subtractQuants = linearQuants (-) -+-- | Helper function used in addQuants and subtractQuants. linearQuants :: (Double -> Double -> Double) -> Quantity -> Quantity                 -> Either QuantityError Quantity linearQuants f (Quantity m1 u1) q2 = case q of

@@ -4,6 +4,10 @@ import Data.List (partition, sort) import qualified Data.Map as M +-- $setup+-- >>> import Control.Applicative+-- >>> import Data.Quantities+ -- | String representation of a unit. Examples: "meter", "foot" type Symbol = String @@ -18,28 +22,39 @@ instance Show SimpleUnit where   show (SimpleUnit s pr p)     | p == 1    = sym-    | otherwise = sym ++ " ** " ++ show p+    | otherwise = sym ++ " ** " ++ showPower p     where sym = pr ++ s -+-- | Data type to hold compound units, which are simple units multiplied+-- together. data CompoundUnit = CompoundUnit { defs   :: Definitions+                                   -- ^ Definitions used to create the units.                                  , sUnits :: [SimpleUnit]+                                   -- ^ List of SimpleUnits that is interpreted+                                   -- as the units being multiplied together.                                  } deriving (Eq, Ord)  instance Show CompoundUnit where   show (CompoundUnit _ us) = unwords . map showCompUnit' $ showSort us - -- | Show a single unit, but prepend with '/' if negative showCompUnit' :: SimpleUnit -> String-showCompUnit' (SimpleUnit s pr p)-  | p == 1    = sym-  | p == -1   = "/ " ++ sym-  | p < 0     = "/ " ++ sym ++ " ** " ++ show (-p)-  | otherwise = sym ++ " ** " ++ show p-  where sym = pr ++ s+showCompUnit' su@(SimpleUnit _ _ p)+  | p < 0     = "/ " ++ show (su { power = -p })+  | otherwise = show su +{-# ANN showPower "HLint: ignore Too strict if" #-}+-- | Removes decimal if almost integer.+showPower :: Double -> String+showPower d = if isInt d then show (round d :: Integer) else show d+  where isInt x = x == fromInteger (round x) +-- | Will be used when we allow pretty printing of fractional units.+showPrettyNum :: (Show a, Num a) => a -> String+showPrettyNum x = map (pretty M.!) $ show x+  where pretty = M.fromList $ zip "0123456789.-" "⁰¹²³⁴⁵⁶⁷⁸⁹·⁻"++ -- | Combination of magnitude and units. data Quantity = Quantity { magnitude :: Double                            -- ^ Numerical magnitude of quantity.@@ -50,7 +65,7 @@                            -- ^ Units associated with quantity.                            --                            -- >>> units <$> fromString "3.4 m/s^2"-                           -- Right [meter,second ** -2.0]+                           -- Right meter / second ** 2                          } deriving (Ord)  @@ -97,6 +112,9 @@                    | DifferentDefinitionsError CompoundUnit CompoundUnit                      -- ^ Used when two quantities come from different                      -- Definitions.+                   | ScalingFactorError Quantity+                     -- ^ Used when a scaling factor is present in a unit+                     -- conversion.                    deriving (Show, Eq)  @@ -116,7 +134,6 @@ -- >   convertBase x -- -- Returns @Left (UndefinedUnitError "BADUNIT")@- type QuantityComputation = Either QuantityError  -- | Combines equivalent units and removes units with powers of zero.@@ -124,19 +141,23 @@ reduceUnits q = q { units = newUnits }   where newUnits = (units q) { sUnits = reduceUnits' (units' q) } -reduceUnits', removeZeros :: [SimpleUnit] -> [SimpleUnit]-reduceUnits'  = removeZeros . reduceComp . sort+-- | Helper function for reduceUnits.+reduceUnits' :: [SimpleUnit] -> [SimpleUnit]+reduceUnits' = removeZeros . reduceComp . sort   where reduceComp [] = []         reduceComp (SimpleUnit x pr1 p1 : SimpleUnit y pr2 p2: xs)           | (x,pr1) == (y,pr2) = SimpleUnit x pr1 (p1+p2) : reduceComp xs           | otherwise = SimpleUnit x pr1 p1 : reduceComp (SimpleUnit y pr2 p2 : xs)         reduceComp (x:xs) = x : reduceComp xs -+-- | Removes units with powers of zero that are left over from other+-- computations.+removeZeros :: [SimpleUnit] -> [SimpleUnit] removeZeros [] = [] removeZeros (SimpleUnit _ _ 0.0 : xs) = removeZeros xs removeZeros (x:xs) = x : removeZeros xs +-- | Negate the powers of a list of SimpleUnits. invertUnits :: [SimpleUnit] -> [SimpleUnit] invertUnits = map invertSimpleUnit @@ -162,7 +183,8 @@   where expUnits = map (\(SimpleUnit s pr p) -> SimpleUnit s pr (p*y))         newUnits = u { sUnits = expUnits (sUnits u) } -+-- | Data type for the three definition types. Used to hold definitions+-- information when parsing. data Definition = PrefixDefinition { defPrefix   :: Symbol                                    , factor      :: Double                                    , defSynonyms :: [Symbol]}@@ -173,7 +195,8 @@                                    , quantity    :: Quantity                                    , defSynonyms :: [Symbol]} deriving (Show, Eq, Ord) -+-- | Holds information about defined units, prefixes, and bases. Used when+-- parsing new units and performing units conversions. data Definitions = Definitions { bases          :: M.Map String (Double, [SimpleUnit])                                  -- ^ Map from symbol to base units and                                  -- conversion factor to those units.@@ -203,6 +226,7 @@ instance Eq Definitions where   d1 == d2 = defStringHash d1 == defStringHash d2 +-- | Default, empty set of definitions. emptyDefinitions :: Definitions emptyDefinitions = Definitions { bases          = M.empty                                , synonyms       = M.empty

@@ -1,3 +1,4 @@+-- | Holds the default definition string. module Data.Quantities.DefaultUnits (defaultDefString) where  -- | View the source code for this declaration to see what units and prefixes

@@ -1,3 +1,4 @@+-- | Uses parsec to parse definition lines. module Data.Quantities.DefinitionParser where  import Control.Applicative ((<*))@@ -13,6 +14,7 @@   Left err -> error (show err) >> []   Right val -> val +-- | Parsec parser for definitions. parseDefinitions' :: Parser [Definition] parseDefinitions' = many parseDef <* eof @@ -31,6 +33,7 @@ -- comment :: Parser String -- comment = char '#' >> many (noneOf "\n") +-- | Custom eol parsec parser. eol :: Parser Char eol = char '\n' @@ -42,6 +45,7 @@   syns <- many (try parseSynonym)   return $ UnitDefinition s e syns +-- | Parses a unit definition. Example: foot = 12 in = ft = feet parseUnitDef :: Parser Definition parseUnitDef = do   sym   <- parseSymbol <* spaces <* char '='@@ -50,11 +54,12 @@   -- skipMany comment   return $ UnitDefinition sym quant [] +-- | Parses the synonyms at the end of a base or unit definition. parseSynonym :: Parser Symbol parseSynonym = spaces >> char '=' >> spaces >> parseSymbol <* spaces  --- | Parse line containing base definition+-- | Parse line containing base definition. -- Ex: meter = [length] = m parseBaseLine :: Parser Definition parseBaseLine = do@@ -62,6 +67,7 @@   syns <- many (try parseSynonym)   return $ BaseDefinition sym f syns +-- | Parse the base of a base definition. Example: [length] -> length parseBase :: Parser (Symbol, Symbol) parseBase = do   sym <- parseSymbol <* spaces <* char '='@@ -78,6 +84,7 @@   syns <- many (try parsePrefixSynonym)   return $ PrefixDefinition p f syns +-- | Parse the prefix part of a prefix definition. Example: yocto- -> yocto parsePrefix :: Parser (Symbol, Double) parsePrefix = do   pre <- many1 letter <* char '-' <* spaces <* char '='@@ -87,7 +94,7 @@     return (pre, magnitude facQuant)     else fail "No units allowed in prefix definitions" -+-- | Parse the synonyms for a prefix definition. parsePrefixSynonym :: Parser Symbol parsePrefixSynonym = spaces >> char '=' >> spaces >> parseSymbol <* char '-' <* spaces 

@@ -1,3 +1,4 @@+-- | This module builds a Definitions object from a string. module Data.Quantities.Definitions where  import Control.Applicative ((<$>))@@ -18,10 +19,18 @@ readDefinitions s = addDefinitionsHash s <$> d   where d = makeDefinitions (parseDefinitions s) +-- | Monad used for addDefinition. type DefineMonad = StateT Definitions (Either QuantityError)++-- | Converts a list of definitions to the Definitions data structure. Modifies+-- an emptyDefinitions object by combining the incremental additions of each+-- Definition. makeDefinitions :: [Definition] -> Either QuantityError Definitions makeDefinitions ds = execStateT (mapM addDefinition ds) emptyDefinitions +-- | Add one definition to the definitions. Creates a new Definitions object+-- using the information in the Definition, and then unions the Definitions in+-- the state monad with this new object. addDefinition :: Definition -> DefineMonad ()  addDefinition (PrefixDefinition sym fac syns) = do

@@ -10,23 +10,44 @@ import Numeric (readFloat) import Text.ParserCombinators.Parsec -import Data.Quantities.Convert (addQuants, subtractQuants)+import Data.Quantities.Convert (addQuants, subtractQuants, convert) import Data.Quantities.Data +-- | Alternate definition for spaces. Just actual spaces. spaces' :: Parser String spaces' = many $ char ' ' +-- | Parse quantity expression; addition and subtraction allowed. parseExprQuant :: Definitions -> String -> Either QuantityError Quantity parseExprQuant d input = case parse (parseExpr d) "arithmetic" input of   Left err  -> Left $ ParserError $ show err   Right val -> val --- | Converts string to a Quantity using an expression grammar parser.+-- | Simple type used for shorthand type EQuant = Either QuantityError Quantity +-- | Using already compiled definitions, parse expression. Also allows for+-- expressions like "exp1 => exp2" in the middle, which converts the quantity+-- exp1 into the units of the quantity exp2. parseExpr :: Definitions -> Parser EQuant-parseExpr d = spaces' >> parseExpr' d <* spaces'+parseExpr d = (try (parseConvertExpr d) <|> parseSingle) <* eof+  where parseSingle = spaces >> parseExpr' d <* spaces +-- | Parser that accepts "=>" in between two expressions.+parseConvertExpr :: Definitions -> Parser EQuant+parseConvertExpr d = do+  _ <- spaces'+  exp1 <- parseExpr' d <* spaces+  exp2 <- string "=>" >> spaces >> parseExpr' d+  _ <- spaces'+  return $ do+    e1 <- exp1+    e2 <- exp2+    u2 <- units <$> exp2+    case magnitude e2 of+      1.0 -> convert e1 u2+      _   -> Left $ ScalingFactorError e2+ parseExpr', parseTerm :: Definitions -> Parser EQuant parseFactor, parseExpt, parseNestedExpr :: Definitions -> Parser EQuant parseExpr'      d = try (parseTermOp d)     <|> parseTerm d@@ -54,27 +75,32 @@ exptOp = try (opChoice >> spaces' >> return exptEQuants) <?> "expOp"   where opChoice = string "^" <|> string "**" -+-- | Modification of addQuants to account for Either QuantityError Quantity. addEQuants :: EQuant -> EQuant -> EQuant addEQuants (Right a) (Right b) = addQuants a b addEQuants (Left a) _          = Left a addEQuants _ (Left b)          = Left b +-- | Modification of subtractQuants to account for Either QuantityError Quantity. subtractEQuants :: EQuant -> EQuant -> EQuant subtractEQuants (Right a) (Right b) = subtractQuants a b subtractEQuants (Left a) _          = Left a subtractEQuants _ (Left b)          = Left b +-- | Modification of multiplyQuants to account for Either QuantityError Quantity. multiplyEQuants :: EQuant -> EQuant -> EQuant multiplyEQuants (Right a) (Right b) = Right $ multiplyQuants a b multiplyEQuants (Left a) _          = Left a multiplyEQuants _ (Left b)          = Left b +-- | Modification of divideQuants to account for Either QuantityError Quantity. divideEQuants :: EQuant -> EQuant -> EQuant divideEQuants (Right a) (Right b) = Right $ divideQuants a b divideEQuants (Left a) _          = Left a divideEQuants _ (Left b)          = Left b +-- | Modification of exptQuants to account for Either QuantityError Quantity.+-- Returns error if dimensional quantity used in exponent. exptEQuants :: EQuant -> EQuant -> EQuant exptEQuants (Left a) _          = Left a exptEQuants _ (Left b)          = Left b@@ -82,20 +108,23 @@ exptEQuants a b  = Left $ ParserError $ "Used non-dimensionless exponent in " ++ showq   where showq = unwords ["(", show a, ") ** (", show b, ")"] +-- | Modification of parseSymbolNum to handle parsing errors. parseESymbolNum :: Definitions -> Parser EQuant parseESymbolNum d = try (parseENum d) <|> parseESymbol d +-- | Parses a symbol and then parses a prefix form that symbol. parseESymbol :: Definitions -> Parser EQuant parseESymbol d = do   q <- parseSymbol'   return $ preprocessQuantity d q +-- | Parse a number and insert the given definitions into the CompoundUnit. parseENum :: Definitions -> Parser EQuant parseENum d = do   q <- parseNum   return $ Right $ q { units = (units q) { defs = d } } --- | Convert prefixes and synonyms+-- | Parses out prefixes and aliases from quantity's units. preprocessQuantity :: Definitions -> Quantity -> Either QuantityError Quantity preprocessQuantity d (Quantity x us)   | null errs = Right $ Quantity x (CompoundUnit d us')@@ -103,6 +132,7 @@     where ppUnits     = map (preprocessUnit d) (sUnits us)           (errs, us') = partitionEithers ppUnits +-- | Parses prefix and alias, if applicable, from a SimpleUnit. preprocessUnit :: Definitions -> SimpleUnit -> Either QuantityError SimpleUnit preprocessUnit d (SimpleUnit s _ p)   | rs `elem` unitsList d = Right $ SimpleUnit ns np p@@ -111,7 +141,7 @@         np       = prefixSynonyms d M.! rp         ns       = synonyms d M.! rs -+-- | Try to parse a prefix from a symbol. Otherwise, just return the symbol. prefixParser :: Definitions -> String -> (String, String) prefixParser d input = if input `elem` unitsList d                           then ("", input)@@ -119,7 +149,7 @@                             Left _ -> ("", input)                             Right val -> splitAt (length val) input -+-- | Helper function for prefixParser that is a Parsec parser. prefixParser' :: Definitions -> Parser String prefixParser' d = do   pr <- choice $ map (try . string) (prefixes d)@@ -158,9 +188,12 @@ exptMultQuants' a b  = error $ "Used non-dimensionless exponent in " ++ showq   where showq = unwords ["(", show a, ") ** (", show b, ")"] +-- | Parse either a symbol or a number. parseSymbolNum :: Parser Quantity parseSymbolNum = try parseNum <|> parseSymbol' +-- | Parse a symbol with an optional negative sign. A symbol can contain+-- alphanumeric characters and the character '_'. parseSymbol' :: Parser Quantity parseSymbol' = do   neg  <- option "" $ string "-"@@ -169,11 +202,14 @@   _ <- spaces'   return $ baseQuant (timesSign neg 1) [SimpleUnit (symf : rest) "" 1] +-- | Parent function for parseNum' to parse a number. parseNum :: Parser Quantity parseNum = do   num <- parseNum'   return $ baseQuant num [] +-- | Meat of number parser. Parse digits with an optional negative sign and+-- optional exponential. For example, -5.2e4. parseNum' :: Parser Double parseNum' = do   neg <- option "" $ string "-"@@ -183,6 +219,8 @@   _ <- spaces'   return $ timesSign neg $ fst $ head $ readFloat $ whole ++ decimal ++ exponential +-- | Parses just the exponential part of a number. For example, parses "4" from+-- "-5.2e4". parseExponential :: Parser String parseExponential = do   e <- string "e"@@ -190,6 +228,7 @@   pow <- many1 digit   return $ e ++ neg ++ pow +-- | Negate a number if the first argument is a negative sign. timesSign :: String -> Double -> Double timesSign sign x   | sign == "-" = -x

@@ -1,5 +1,5 @@ name:                 quantities-version:              0.2.0+version:              0.3.0 author:               John David Reaver <jdreaver@adlerhorst.com> maintainer:           John David Reaver <jdreaver@adlerhorst.com> build-type:           Simple@@ -52,6 +52,20 @@     default-language: Haskell2010     hs-source-dirs:   test-suite     main-is:          HLint.hs+    type:             exitcode-stdio-1.0++test-suite doctest+    build-depends:    base, doctest == 0.9.*, Glob == 0.7.*+    default-language: Haskell2010+    hs-source-dirs:   test-suite+    main-is:          DocTest.hs+    type:             exitcode-stdio-1.0++test-suite coverage+    build-depends:    base, process == 1.1.*, regex-compat == 0.95.*+    default-language: Haskell2010+    hs-source-dirs:   test-suite+    main-is:          DocCoverage.hs     type:             exitcode-stdio-1.0  source-repository head

@@ -0,0 +1,25 @@+module Main (main) where++import Data.List (genericLength)+import Data.Maybe (catMaybes)+import System.Exit (exitFailure, exitSuccess)+import System.Process (readProcess)+import Text.Regex (matchRegex, mkRegex)++average :: (Fractional a, Real b) => [b] -> a+average xs = realToFrac (sum xs) / genericLength xs++expected :: Fractional a => a+expected = 90++main :: IO ()+main = do+    output <- readProcess "cabal" ["haddock"] ""+    if average (match output) >= expected+        then exitSuccess+        else putStr output >> exitFailure++match :: String -> [Int]+match = fmap read . concat . catMaybes . fmap (matchRegex pattern) . lines+  where+    pattern = mkRegex "^ *([0-9]*)% "

@@ -0,0 +1,7 @@+module Main (main) where++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)++main :: IO ()+main = glob "library/**/*.hs" >>= doctest