stylish-cabal 0.4.0.1 → 0.4.1.0
raw patch · 11 files changed
+481/−492 lines, 11 filesdep ~base-compatdep ~hspec
Dependency ranges changed: base-compat, hspec
Files
- src/Parse.hs +43/−47
- src/Render.hs +8/−6
- src/Render/Lib.hs +51/−51
- src/Render/Lib/Haddock.hs +76/−77
- src/Render/Options.hs +17/−17
- src/StylishCabal.hs +25/−20
- src/Transform.hs +178/−180
- src/Types/Block.hs +15/−15
- src/Types/Field.hs +61/−60
- stylish-cabal.cabal +4/−4
- tests/utils/Expectations.hs +3/−15
src/Parse.hs view
@@ -1,18 +1,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language CPP #-}-{-# Language StandaloneDeriving #-}-{-# Language DeriveGeneric #-}-{-# Language DeriveDataTypeable #-}-{-# Language DeriveFunctor #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-} module Parse- ( parsePackageDescription- , readPackageDescription- , displayError- , printWarnings- , Result(..)- , result- ) where+ ( parsePackageDescription+ , readPackageDescription+ , displayError+ , printWarnings+ , Result(..)+ , result+ ) where import Control.DeepSeq import Control.Monad.Compat@@ -20,9 +20,9 @@ import Data.Maybe import Distribution.PackageDescription import Distribution.PackageDescription.Parsec- ( parseGenericPackageDescription- , runParseResult- )+ ( parseGenericPackageDescription+ , runParseResult+ ) import Distribution.Parsec.Common import Distribution.Simple.Utils import Distribution.Verbosity@@ -30,19 +30,16 @@ import GHC.Generics import Prelude.Compat import System.Exit- #if MIN_VERSION_base(4,9,0) import Data.Functor.Classes #endif- -- | Like Cabal's @ParseResult@, but treats warnings as a separate failure -- case. data Result a- = Error [PError] -- ^ Parse errors.- | Warn [PWarning] -- ^ Warnings emitted during parse.- | Success a -- ^ The input is a compliant package description.- deriving (Show, Eq, Functor, Generic, Typeable, Data)-+ = Error [PError] -- ^ Parse errors.+ | Warn [PWarning] -- ^ Warnings emitted during parse.+ | Success a -- ^ The input is a compliant package description.+ deriving (Show, Eq, Functor, Generic, Typeable, Data) #if MIN_VERSION_base(4,6,0) deriving instance Generic1 Result #endif@@ -57,24 +54,23 @@ #if MIN_VERSION_base(4,9,0) instance Show1 Result where- liftShowsPrec sp _ p (Success n) = showsUnaryWith sp "Success" p n- liftShowsPrec _ _ p (Warn pws) = showsUnaryWith showsPrec "Warn" p pws- liftShowsPrec _ _ p (Error s) = showsUnaryWith showsPrec "Error" p s+ liftShowsPrec sp _ p (Success n) = showsUnaryWith sp "Success" p n+ liftShowsPrec _ _ p (Warn pws) = showsUnaryWith showsPrec "Warn" p pws+ liftShowsPrec _ _ p (Error s) = showsUnaryWith showsPrec "Error" p s instance Eq1 Result where- liftEq eq (Success a) (Success b) = eq a b- liftEq _ (Error s) (Error s2) = s == s2- liftEq _ (Warn pws) (Warn pws2) = pws == pws2- liftEq _ _ _ = False+ liftEq eq (Success a) (Success b) = eq a b+ liftEq _ (Error s) (Error s2) = s == s2+ liftEq _ (Warn pws) (Warn pws2) = pws == pws2+ liftEq _ _ _ = False #endif- -- | Case analysis for 'Result'. result :: ([PError] -> b) -> ([PWarning] -> b) -> (a -> b) -> Result a -> b result e w s p =- case p of- Error l -> e l- Warn ws -> w ws- Success r -> s r+ case p of+ Error l -> e l+ Warn ws -> w ws+ Success r -> s r deriving instance Data PError @@ -98,33 +94,33 @@ -- warnings generally indicate a version-related inconsistency, so we play -- it safe here. parsePackageDescription input =- let (warnings, r) = runParseResult $ parseGenericPackageDescription input- in case r of- Left (_, errors) -> Error errors- Right x- | null warnings -> parseResult x- | otherwise -> Warn warnings+ let (warnings, r) = runParseResult $ parseGenericPackageDescription input+ in case r of+ Left (_, errors) -> Error errors+ Right x+ | null warnings -> parseResult x+ | otherwise -> Warn warnings where parseResult gpd =- if specVersionRaw (packageDescription gpd) == Right anyVersion- then Warn [PWarning PWTOther zeroPos versWarning]- else Success gpd+ if specVersionRaw (packageDescription gpd) == Right anyVersion+ then Warn [PWarning PWTOther zeroPos versWarning]+ else Success gpd versWarning =- "File does not specify a cabal-version. stylish-cabal requires at least 1.2"+ "File does not specify a cabal-version. stylish-cabal requires at least 1.2" -- | Shorthand to combine 'parsePackageDescription' and one of 'printWarnings' or -- 'displayError'. The given 'FilePath' is used only for error messages and -- is not read from. readPackageDescription fpath =- result (displayError fpath) (printWarnings fpath) return . parsePackageDescription+ result (displayError fpath) (printWarnings fpath) return . parsePackageDescription -- | Print some warnings to 'stderr' and exit. printWarnings :: Maybe FilePath -> [PWarning] -> IO a printWarnings fpath ps =- mapM_ (warn normal . showPWarning (fromMaybe "<input>" fpath)) ps >> exitFailure+ mapM_ (warn normal . showPWarning (fromMaybe "<input>" fpath)) ps >> exitFailure -- | Print a parse error to 'stderr', annotated with filepath if available, -- then exit. displayError :: Maybe FilePath -> [PError] -> IO a displayError fpath warns =- mapM_ (warn normal . showPError (fromMaybe "<input>" fpath)) warns >> exitFailure+ mapM_ (warn normal . showPError (fromMaybe "<input>" fpath)) warns >> exitFailure
src/Render.hs view
@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-dodgy-imports #-}-{-# Language RecordWildCards #-}-{-# Language StandaloneDeriving #-}-{-# Language FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleContexts #-} module Render ( blockBodyToDoc@@ -9,6 +9,7 @@ import Data.List.Compat hiding (group) import Data.Maybe+import Data.Monoid.Compat import Data.Ord import Distribution.Pretty import Distribution.Types.Dependency@@ -24,7 +25,7 @@ import Documentation.Haddock.Types import Prelude.Compat hiding ((<$>)) import qualified Prelude.Compat as P-import Text.PrettyPrint.ANSI.Leijen+import Text.PrettyPrint.ANSI.Leijen hiding ((<>)) import Render.Lib import Render.Options@@ -86,8 +87,9 @@ | otherwise = pure $ colon <> indent (k - 1) (deps " ") where deps lsep =- encloseSep (string lsep) empty (string ", ") $- map showField $ sortBy (comparing fst) bs+ enclose (string lsep) empty $+ hcat $+ intersperse (hardline <> string ", ") $ map showField $ sortBy (comparing fst) bs longest = maximum $ map (length . unP . fst) bs hasRequires = any (\(_, c) -> not (isDefaultRenaming $ includeRequiresRn c)) bs showField (P fName, i@IncludeRenaming {..})
src/Render/Lib.hs view
@@ -1,20 +1,21 @@-{-# Language FlexibleContexts #-}-{-# Language OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-} module Render.Lib- ( P(..)- , renderBlockHead- , showVersionRange- , moduleDoc- , rexpModuleDoc- , filepath- , renderTestedWith- , exeDependencyAsDependency- , renderDescription- ) where+ ( P(..)+ , renderBlockHead+ , showVersionRange+ , moduleDoc+ , rexpModuleDoc+ , filepath+ , renderTestedWith+ , exeDependencyAsDependency+ , renderDescription+ ) where import Data.Char import Data.List.Compat+import Data.Monoid.Compat import Distribution.Compiler import Distribution.ModuleName import Distribution.PackageDescription@@ -24,25 +25,25 @@ import Distribution.Types.UnqualComponentName import Distribution.Version import Prelude.Compat-import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>)) import Render.Lib.Haddock (renderDescription) import Render.Options import Types.Block newtype P = P- { unP :: String- } deriving (Eq)+ { unP :: String+ } deriving (Eq) instance Ord P where- compare (P "base") (P "base") = EQ- compare (P "base") _ = LT- compare _ (P "base") = GT- compare (P p1) (P p2) = compare p1 p2+ compare (P "base") (P "base") = EQ+ compare (P "base") _ = LT+ compare _ (P "base") = GT+ compare (P p1) (P p2) = compare p1 p2 renderTestedWith ts =- fillSep . punctuate comma <$>- mapM (\(compiler, vers) -> showVersioned (showCompiler compiler, vers)) ts+ fillSep . punctuate comma <$>+ mapM (\(compiler, vers) -> showVersioned (showCompiler compiler, vers)) ts where showCompiler (OtherCompiler x) = x showCompiler (HaskellSuite x) = x@@ -50,17 +51,17 @@ showVersioned :: (String, VersionRange) -> Render Doc showVersioned (pn, v')- | v' == anyVersion = pure $ string pn- | otherwise = fmap (string pn <+>) (showVersionRange v')+ | v' == anyVersion = pure $ string pn+ | otherwise = fmap (string pn <+>) (showVersionRange v') showVersionRange r = do- opts <- ask- return $- cataVersionRange fold' $- (if simplifyVersions opts- then simplifyVersionRange- else id)- r+ opts <- ask+ return $+ cataVersionRange fold' $+ (if simplifyVersions opts+ then simplifyVersionRange+ else id)+ r where fold' AnyVersionF = empty fold' (ThisVersionF v) = green "==" <+> dullyellow (string (prettyShow v))@@ -74,23 +75,22 @@ fold' (IntersectVersionRangesF a b) = a <+> green "&&" <+> b fold' (VersionRangeParensF a) = parens a - filepath :: String -> Doc filepath x- | null x = string "\"\""- | any isSpace x = string $ show x- | otherwise = string x+ | null x = string "\"\""+ | any isSpace x = string $ show x+ | otherwise = string x moduleDoc = string . intercalate "." . components rexpModuleDoc (ModuleReexport pkg origname name) =- maybe empty (\f -> string (unPackageName f) <> colon) pkg <>- (if origname == name- then moduleDoc origname- else moduleDoc origname <+> "as" <+> moduleDoc name)+ maybe empty (\f -> string (unPackageName f) <> colon) pkg <>+ (if origname == name+ then moduleDoc origname+ else moduleDoc origname <+> "as" <+> moduleDoc name) exeDependencyAsDependency (ExeDependency pkg comp vers) =- (P $ unPackageName pkg ++ ":" ++ unUnqualComponentName comp, vers)+ (P $ unPackageName pkg ++ ":" ++ unUnqualComponentName comp, vers) renderBlockHead (If c) = (dullblue "if" <+>) <$> showPredicate c renderBlockHead x = pure $ r x@@ -115,25 +115,25 @@ showPredicate (Var x) = showVar x showPredicate (CNot p) = fmap (dullmagenta (string "!") <>) (maybeParens p) showPredicate (CAnd a b) =- liftM2 (\x y -> x <+> dullblue (string "&&") <+> y) (maybeParens a) (maybeParens b)+ liftM2 (\x y -> x <+> dullblue (string "&&") <+> y) (maybeParens a) (maybeParens b) showPredicate (COr a b) =- liftM2 (\x y -> x <+> dullblue (string "||") <+> y) (maybeParens a) (maybeParens b)+ liftM2 (\x y -> x <+> dullblue (string "||") <+> y) (maybeParens a) (maybeParens b) showPredicate (Lit b) = pure $ string $ show b maybeParens p =- case p of- Lit {} -> showPredicate p- Var {} -> showPredicate p- CNot {} -> showPredicate p- _ -> parens <$> showPredicate p+ case p of+ Lit {} -> showPredicate p+ Var {} -> showPredicate p+ CNot {} -> showPredicate p+ _ -> parens <$> showPredicate p showVar :: ConfVar -> Render Doc showVar (Impl compiler vers) = do- v <- showVersioned (prettyShow compiler, vers)- pure $ dullgreen $ string "impl" <> parens (dullblue v)+ v <- showVersioned (prettyShow compiler, vers)+ pure $ dullgreen $ string "impl" <> parens (dullblue v) showVar (Flag f) =- pure $ dullgreen $ string "flag" <> parens (dullblue $ string (unFlagName f))+ pure $ dullgreen $ string "flag" <> parens (dullblue $ string (unFlagName f)) showVar (OS w) =- pure $ dullgreen $ string "os" <> parens (dullblue $ string $ map toLower $ show w)+ pure $ dullgreen $ string "os" <> parens (dullblue $ string $ map toLower $ show w) showVar (Arch a) =- pure $ dullgreen $ string "arch" <> parens (dullblue $ string $ map toLower $ show a)+ pure $ dullgreen $ string "arch" <> parens (dullblue $ string $ map toLower $ show a)
src/Render/Lib/Haddock.hs view
@@ -1,6 +1,6 @@-{-# Language NoMonomorphismRestriction #-}-{-# Language OverloadedStrings #-}-{-# Language RecordWildCards #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} module Render.Lib.Haddock where @@ -8,25 +8,26 @@ import Data.Char (isSpace) import Data.List.Compat import Data.List.Split+import Data.Monoid.Compat import Documentation.Haddock.Parser (Identifier) import Documentation.Haddock.Types import Prelude.Compat-import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>)) data FlattenBehavior- = Flatten- | WordBreak+ = Flatten+ | WordBreak data TextPosition- = ParaStart- | Body- deriving (Eq)+ = ParaStart+ | Body+ deriving (Eq) data DocContext = DocContext- { flattenBehavior :: FlattenBehavior- , textPosition :: TextPosition- , listContext :: Bool- }+ { flattenBehavior :: FlattenBehavior+ , textPosition :: TextPosition+ , listContext :: Bool+ } flattenedBody = withReader $ \d -> d {flattenBehavior = Flatten, textPosition = Body} @@ -42,7 +43,7 @@ -- to change rendering logic entirely inside a code block (i.e. don't -- fillSep words). renderDescription =- vcat . intersperse (green ".") . map ((`runReader` defaultDocContext) . go) . flatten+ vcat . intersperse (green ".") . map ((`runReader` defaultDocContext) . go) . flatten where flatten (DocAppend d1 d2) = flatten d1 ++ flatten d2 flatten d = [d]@@ -54,83 +55,81 @@ go (DocMonospaced d) = enclose (green "@") (green "@") <$> flattenedBody (go d) go (DocBold d) = enclose (green "__") (green "__") <$> flattenedBody (go d) go (DocHeader (Header l t)) =- (green (strBody $ replicate l '=') <+>) <$> inBody (go t)+ (green (strBody $ replicate l '=') <+>) <$> inBody (go t) go (DocAppend a b) = liftM2 (<>) (go a) (inBody $ go b) go (DocParagraph d) = inPara $ go d go (DocUnorderedList ds) = do- docs <-- forM ds $ \item -> do- doc <- inList $ inPara $ go item- return $ hang 2 $ string "*" <+> doc- return $ vcat docs+ docs <-+ forM ds $ \item -> do+ doc <- inList $ inPara $ go item+ return $ hang 2 $ string "*" <+> doc+ return $ vcat docs go (DocOrderedList ds) = do- docs <-- forM (zip [1 ..] ds) $ \(n, item) -> do- doc <- inList $ inPara $ go item- return $ hang 3 $ integer n <> "." <+> doc- return $ vcat docs+ docs <-+ forM (zip [1 ..] ds) $ \(n, item) -> do+ doc <- inList $ inPara $ go item+ return $ hang 3 $ integer n <> "." <+> doc+ return $ vcat docs go (DocCodeBlock cb) = do- DocContext {..} <- ask- return $- case cb of- DocString s- | all (`notElem` ['{', '}']) s && not listContext ->- green ">" <+> arrowblock s- | listContext && notElem '\n' s ->- cat [green "@", string s, green "@"]- y -> vcat [green "@", goplain y <> green "@"]+ DocContext {..} <- ask+ return $+ case cb of+ DocString s+ | all (`notElem` ['{', '}']) s && not listContext ->+ green ">" <+> arrowblock s+ | listContext && notElem '\n' s -> cat [green "@", string s, green "@"]+ y -> vcat [green "@", goplain y <> green "@"] go (DocString s) = do- DocContext {..} <- ask- return $- case flattenBehavior of- Flatten ->- case textPosition of- Body -> strBody s- ParaStart -> strPara s- WordBreak ->- fillSep $- (if textPosition == ParaStart- then map2 strPara strBody- else map strBody) $- splitWhen isSpace s+ DocContext {..} <- ask+ return $+ case flattenBehavior of+ Flatten ->+ case textPosition of+ Body -> strBody s+ ParaStart -> strPara s+ WordBreak ->+ fillSep $+ (if textPosition == ParaStart+ then map2 strPara strBody+ else map strBody) $+ splitWhen isSpace s go (DocDefList ds) = do- docs <-- forM ds $ \(hdr, body) -> do- rhdr <- inBody $ go hdr- rbdy <- inBody $ go body- return $ enclose (green "[") (green "]") rhdr <+> rbdy- return $ vcat docs+ docs <-+ forM ds $ \(hdr, body) -> do+ rhdr <- inBody $ go hdr+ rbdy <- inBody $ go body+ return $ enclose (green "[") (green "]") rhdr <+> rbdy+ return $ vcat docs go (DocExamples es) =- return $- vcat $- map- (\Example {..} ->- vcat $- (green ">>>" <+> string exampleExpression) : map string exampleResult)- es+ return $+ vcat $+ map+ (\Example {..} ->+ vcat $ (green ">>>" <+> string exampleExpression) : map string exampleResult)+ es go (DocModule x) = return $ enclose (green "\"") (green "\"") (strBody x) go (DocIdentifier (c, x, c2)) =- return $ enclose (green $ char c) (green $ char c2) (string x)+ return $ enclose (green $ char c) (green $ char c2) (string x) go (DocMathDisplay x) = return $ enclose (green "\\[") (green "\\]") (strBody x) go (DocMathInline x) = return $ enclose (green "\\(") (green "\\)") (strBody x) -- go (DocAName x) = return $ enclose (green "#") (green "#") (strBody x) go (DocHyperlink (Hyperlink h l)) =- return $- enclose (green "<") (green ">") (string $ h ++ maybe "" (" " ++) (unNl <$> l))+ return $+ enclose (green "<") (green ">") (string $ h ++ maybe "" (" " ++) (unNl <$> l)) go (DocPic (Picture p t)) =- return $- enclose (green "<<") (green ">>") (string $ p ++ maybe "" (" " ++) (unNl <$> t))+ return $+ enclose (green "<<") (green ">>") (string $ p ++ maybe "" (" " ++) (unNl <$> t)) go x = error $ "Unhandled Haddock AST node: " ++ show x unNl =- map- (\x ->- if x == '\n'- then ' '- else x)+ map+ (\x ->+ if x == '\n'+ then ' '+ else x) goplain (DocString s) = strPara $ escapeHtml s goplain (DocAppend a b) = goplain a <> goplain b goplain (DocIdentifier (a, b, c)) =- enclose (green (char a)) (green (char c)) (string b)+ enclose (green (char a)) (green (char c)) (string b) goplain (DocEmphasis x) = enclose (green "/") (green "/") (goplain x) goplain (DocModule x) = enclose (green "\"") (green "\"") (string x) goplain n = error $ "Unhandled in goplain: " ++ show n@@ -145,22 +144,22 @@ escapeHtml "" = "" escapeHtml ('\n':'\n':xs) = '\n' : '.' : '\n' : escapeHtml xs escapeHtml ('\n':xs)- | (spcs, '-':chrs) <- span isSpace xs = '\n' : spcs ++ ('\1' : '-' : escapeHtml chrs)+ | (spcs, '-':chrs) <- span isSpace xs = '\n' : spcs ++ ('\1' : '-' : escapeHtml chrs) escapeHtml (c:cs) = c : escapeHtml cs strPara ('>':'>':'>':cs) = text "\\>>>" <> strBody cs strPara (x:cs) -- >, *, and - are mentioned by the haddock docks, but [ is also -- a special character b/c it starts a definition list- | x `elem` ['>', '*', '-', '['] = char '\\' <> char x <> strBody cs+ | x `elem` ['>', '*', '-', '['] = char '\\' <> char x <> strBody cs strPara x = strBody x strBody ('\n':x) = line <> strPara x strBody ('{':xs) = "{" <> strBody xs strBody ('}':xs) = "}" <> strBody xs strBody (x:xs)- | x `elem` ['\\', '/', '\'', '`', '"', '@', '<', '#'] =- char '\\' <> char x <> strBody xs- | x == '\1' = char '\\' <> strBody xs- | otherwise = char x <> strBody xs+ | x `elem` ['\\', '/', '\'', '`', '"', '@', '<', '#'] =+ char '\\' <> char x <> strBody xs+ | x == '\1' = char '\\' <> strBody xs+ | otherwise = char x <> strBody xs strBody "" = empty
src/Render/Options.hs view
@@ -1,11 +1,11 @@-{-# Language FlexibleContexts #-}-{-# Language DeriveDataTypeable #-}-{-# Language DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} module Render.Options- ( module Render.Options- , module Control.Monad.Reader- ) where+ ( module Render.Options+ , module Control.Monad.Reader+ ) where import Control.Monad.Reader hiding (mapM) import Data.Data@@ -17,22 +17,22 @@ type Render = Reader RenderOptions data RenderOptions = RenderOptions- { -- | Number of spaces to use for indentation.- indentSize :: Int- -- | If 'True', @stylish-cabal@ will use- -- 'Distribution.Version.simplifyVersionRange' to simplify every- -- version range present in the Cabal file. For example, it'll turn- -- a constraint like @>= 3.0 && <= 3.0@ into just @== 3.0@.- , simplifyVersions :: Bool- } deriving (Show, Eq, Generic, Typeable, Data)+ { -- | Number of spaces to use for indentation.+ indentSize :: Int+ -- | If 'True', @stylish-cabal@ will use+ -- 'Distribution.Version.simplifyVersionRange' to simplify every+ -- version range present in the Cabal file. For example, it'll turn+ -- a constraint like @>= 3.0 && <= 3.0@ into just @== 3.0@.+ , simplifyVersions :: Bool+ } deriving (Show, Eq, Generic, Typeable, Data) instance Default RenderOptions where- def = RenderOptions {indentSize = 2, simplifyVersions = False}+ def = RenderOptions {indentSize = 2, simplifyVersions = False} indentM :: Doc -> Render Doc indentM k = do- s <- asks indentSize- return $ indent s k+ s <- asks indentSize+ return $ indent s k (<&>) = flip fmap
src/StylishCabal.hs view
@@ -1,29 +1,34 @@ -- | Cabal file formatter. module StylishCabal- ( -- * Formatting Cabal files- pretty- , prettyOpts- , RenderOptions(..)- , render- -- * Parsing utilities- , parsePackageDescription- , readPackageDescription- , Result(..)- , result- , printWarnings- , displayError- -- * Reexports- , Default(..)- , Doc- , plain- , displayIO- , displayS- ) where+ ( -- * Formatting Cabal files+ pretty+ , prettyOpts+ , RenderOptions(..)+ , render+ -- * Parsing utilities+ , parsePackageDescription+ , readPackageDescription+ , Result(..)+ , PError(..)+ , PWarning(..)+ , result+ , printWarnings+ , displayError+ -- * Reexports+ , Default(..)+ , GenericPackageDescription+ , Doc+ , plain+ , displayIO+ , displayS+ ) where import Data.Default+import Data.Monoid.Compat import Distribution.PackageDescription (GenericPackageDescription)+import Distribution.Parsec.Common import Prelude.Compat-import Text.PrettyPrint.ANSI.Leijen hiding (pretty)+import Text.PrettyPrint.ANSI.Leijen hiding ((<>), pretty) import Parse import Render
src/Transform.hs view
@@ -1,9 +1,9 @@-{-# Language FlexibleContexts #-}-{-# Language RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-} module Transform- ( toBlocks- ) where+ ( toBlocks+ ) where import Control.Arrow import Control.DeepSeq@@ -28,69 +28,69 @@ (<&>) = flip fmap toBlocks GenericPackageDescription {..} =- ( pdToFields packageDescription- , concat- [ map setupBuildInfoToBlock $ maybeToList (setupBuildInfo packageDescription)- , map sourceRepoToBlock (sourceRepos packageDescription)- , map flagToBlock genPackageFlags- , map (libToBlock packageDescription Nothing) $ maybeToList condLibrary- , map (uncurry (libToBlock packageDescription) . first Just) condSubLibraries- , map (uncurry $ foreignLibToBlock packageDescription) condForeignLibs- , map (uncurry $ exeToBlock packageDescription) condExecutables- , map (uncurry $ testToBlock packageDescription) condTestSuites- , map (uncurry $ benchToBlock packageDescription) condBenchmarks- ])+ ( pdToFields packageDescription+ , concat+ [ map setupBuildInfoToBlock $ maybeToList (setupBuildInfo packageDescription)+ , map sourceRepoToBlock (sourceRepos packageDescription)+ , map flagToBlock genPackageFlags+ , map (libToBlock packageDescription Nothing) $ maybeToList condLibrary+ , map (uncurry (libToBlock packageDescription) . first Just) condSubLibraries+ , map (uncurry $ foreignLibToBlock packageDescription) condForeignLibs+ , map (uncurry $ exeToBlock packageDescription) condExecutables+ , map (uncurry $ testToBlock packageDescription) condTestSuites+ , map (uncurry $ benchToBlock packageDescription) condBenchmarks+ ]) setupBuildInfoToBlock SetupBuildInfo {..} -- defaultSetupDepends doesn't correspond to anything in the cabal file =- defaultSetupDepends `seq`- Block CustomSetup [nonEmpty (dependencies "setup-depends") setupDepends] []+ defaultSetupDepends `seq`+ Block CustomSetup [nonEmpty (dependencies "setup-depends") setupDepends] [] sourceRepoToBlock SourceRepo {..} =- Block- (SourceRepo_ repoKind)- [ stringField "type" . showType =<< repoType- , stringField "location" =<< repoLocation- , file "subdir" =<< repoSubdir- , file "tag" =<< repoTag- , file "branch" =<< repoBranch- , file "module" =<< repoModule- ]- []+ Block+ (SourceRepo_ repoKind)+ [ stringField "type" . showType =<< repoType+ , stringField "location" =<< repoLocation+ , file "subdir" =<< repoSubdir+ , file "tag" =<< repoTag+ , file "branch" =<< repoBranch+ , file "module" =<< repoModule+ ]+ [] where showType (OtherRepoType n) = n showType x = map toLower $ show x pdToFields pd@PackageDescription {..} =- [ guard newSpec >> cabalVersion "cabal-version" specVersionRaw- , stringField "name" (unPackageName $ pkgName package)- , version "version" (pkgVersion package)- , nonEmpty (stringField "synopsis") synopsis- , desc description- , either- (spdxLicenseField "license")- (ffilter (/= UnspecifiedLicense) (licenseField "license"))- licenseRaw- , license' licenseFiles- , nonEmpty (stringField "copyright") copyright- , nonEmpty (stringField "author") author- , nonEmpty (stringField "maintainer") maintainer- , nonEmpty (stringField "stability") stability- , nonEmpty (testedField "tested-with") testedWith- , nonEmpty (stringField "category") category- , nonEmpty (stringField "homepage") homepage- , nonEmpty (stringField "package-url") pkgUrl- , nonEmpty (stringField "bug-reports") bugReports- , stringField "build-type" . show =<< buildTypeRaw- , nonEmpty (longList "extra-tmp-files") extraTmpFiles- , nonEmpty (longList "extra-source-files") extraSrcFiles- , nonEmpty (longList "extra-doc-files") extraDocFiles- , nonEmpty (longList "data-files") dataFiles- , nonEmpty (stringField "data-dir") dataDir- , guard (not newSpec) >> cabalVersion "cabal-version" specVersionRaw- ] ++- map (uncurry stringField) customFieldsPD+ [ guard newSpec >> cabalVersion "cabal-version" specVersionRaw+ , stringField "name" (unPackageName $ pkgName package)+ , version "version" (pkgVersion package)+ , nonEmpty (stringField "synopsis") synopsis+ , desc description+ , either+ (spdxLicenseField "license")+ (ffilter (/= UnspecifiedLicense) (licenseField "license"))+ licenseRaw+ , license' licenseFiles+ , nonEmpty (stringField "copyright") copyright+ , nonEmpty (stringField "author") author+ , nonEmpty (stringField "maintainer") maintainer+ , nonEmpty (stringField "stability") stability+ , nonEmpty (testedField "tested-with") testedWith+ , nonEmpty (stringField "category") category+ , nonEmpty (stringField "homepage") homepage+ , nonEmpty (stringField "package-url") pkgUrl+ , nonEmpty (stringField "bug-reports") bugReports+ , stringField "build-type" . show =<< buildTypeRaw+ , nonEmpty (longList "extra-tmp-files") extraTmpFiles+ , nonEmpty (longList "extra-source-files") extraSrcFiles+ , nonEmpty (longList "extra-doc-files") extraDocFiles+ , nonEmpty (longList "data-files") dataFiles+ , nonEmpty (stringField "data-dir") dataDir+ , guard (not newSpec) >> cabalVersion "cabal-version" specVersionRaw+ ] +++ map (uncurry stringField) customFieldsPD where newSpec = withinRange packageVersion (orLaterVersion $ mkVersion [2, 1]) packageVersion = specVersion pd@@ -99,158 +99,156 @@ license' ls = commas "license-files" ls flagToBlock MkFlag {..} =- Block- (Flag_ (unFlagName flagName))- [ stringField "default" (show flagDefault)- , ffilter id (stringField "manual" . show) flagManual- , desc flagDescription- ]- []+ Block+ (Flag_ (unFlagName flagName))+ [ stringField "default" (show flagDefault)+ , ffilter id (stringField "manual" . show) flagManual+ , desc flagDescription+ ]+ [] libToBlock pkg libname CondNode {..} =- deepseq condTreeConstraints $- Block- (Library_ $ unUnqualComponentName <$> libname)- (libDataToFields condTreeData ++ buildInfoToFields pkg (libBuildInfo condTreeData))- (nodesToBlocks pkg libBuildInfo libDataToFields condTreeComponents)+ deepseq condTreeConstraints $+ Block+ (Library_ $ unUnqualComponentName <$> libname)+ (libDataToFields condTreeData ++ buildInfoToFields pkg (libBuildInfo condTreeData))+ (nodesToBlocks pkg libBuildInfo libDataToFields condTreeComponents) libDataToFields Library {..} =- libName `deepseq`- [ ffilter not (stringField "exposed" . show) libExposed- , nonEmpty (modules "exposed-modules") exposedModules- , nonEmpty (rexpModules "reexported-modules") reexportedModules- , nonEmpty (modules "signatures") signatures- ]+ libName `deepseq`+ [ ffilter not (stringField "exposed" . show) libExposed+ , nonEmpty (modules "exposed-modules") exposedModules+ , nonEmpty (rexpModules "reexported-modules") reexportedModules+ , nonEmpty (modules "signatures") signatures+ ] foreignLibToBlock pkg libname CondNode {..} =- condTreeConstraints `deepseq`- Block- (ForeignLib_ $ unUnqualComponentName libname)- (foreignLibDataToFields condTreeData ++- buildInfoToFields pkg (foreignLibBuildInfo condTreeData))- (nodesToBlocks pkg foreignLibBuildInfo foreignLibDataToFields condTreeComponents)+ condTreeConstraints `deepseq`+ Block+ (ForeignLib_ $ unUnqualComponentName libname)+ (foreignLibDataToFields condTreeData +++ buildInfoToFields pkg (foreignLibBuildInfo condTreeData))+ (nodesToBlocks pkg foreignLibBuildInfo foreignLibDataToFields condTreeComponents) foreignLibDataToFields ForeignLib {..} =- foreignLibName `seq`- [ ffilter (== ForeignLibNativeShared) (flibType "type") foreignLibType- , nonEmpty (flibOptions "options") foreignLibOptions- , stringField "lib-version-info" . showLVI =<< foreignLibVersionInfo- , version "lib-version-linux" =<< foreignLibVersionLinux- , nonEmpty (commas "mod-def-file") foreignLibModDefFile- ]+ foreignLibName `seq`+ [ ffilter (== ForeignLibNativeShared) (flibType "type") foreignLibType+ , nonEmpty (flibOptions "options") foreignLibOptions+ , stringField "lib-version-info" . showLVI =<< foreignLibVersionInfo+ , version "lib-version-linux" =<< foreignLibVersionLinux+ , nonEmpty (commas "mod-def-file") foreignLibModDefFile+ ] where showLVI l =- let (a, b, c) = libVersionInfoCRA l- in show a ++ ":" ++ show b ++ ":" ++ show c+ let (a, b, c) = libVersionInfoCRA l+ in show a ++ ":" ++ show b ++ ":" ++ show c exeToBlock pkg exeName CondNode {..} =- deepseq condTreeConstraints $- Block- (Exe_ (unUnqualComponentName exeName))- (exeDataToFields condTreeData ++ buildInfoToFields pkg (buildInfo condTreeData))- (nodesToBlocks pkg buildInfo exeDataToFields condTreeComponents)+ deepseq condTreeConstraints $+ Block+ (Exe_ (unUnqualComponentName exeName))+ (exeDataToFields condTreeData ++ buildInfoToFields pkg (buildInfo condTreeData))+ (nodesToBlocks pkg buildInfo exeDataToFields condTreeComponents) exeDataToFields Executable {..} =- exeName `seq`- [ nonEmpty (stringField "main-is") modulePath- , ffilter (== ExecutablePrivate) (\_ -> stringField "scope" "private") exeScope- ]+ exeName `seq`+ [ nonEmpty (stringField "main-is") modulePath+ , ffilter (== ExecutablePrivate) (\_ -> stringField "scope" "private") exeScope+ ] testToBlock pkg testName CondNode {..} =- deepseq condTreeConstraints $- Block- (TestSuite_ (unUnqualComponentName testName))- (testDataToFields condTreeData ++- buildInfoToFields pkg (testBuildInfo condTreeData))- (nodesToBlocks pkg testBuildInfo testDataToFields condTreeComponents)+ deepseq condTreeConstraints $+ Block+ (TestSuite_ (unUnqualComponentName testName))+ (testDataToFields condTreeData ++ buildInfoToFields pkg (testBuildInfo condTreeData))+ (nodesToBlocks pkg testBuildInfo testDataToFields condTreeComponents) testDataToFields TestSuite {..} =- testName `seq`- case testInterface of- TestSuiteExeV10 v f ->- v `seq` [stringField "type" "exitcode-stdio-1.0", stringField "main-is" f]- TestSuiteLibV09 v m ->- v `seq` [stringField "type" "detailed-0.9", module_ "test-module" m]- _ -> []+ testName `seq`+ case testInterface of+ TestSuiteExeV10 v f ->+ v `seq` [stringField "type" "exitcode-stdio-1.0", stringField "main-is" f]+ TestSuiteLibV09 v m ->+ v `seq` [stringField "type" "detailed-0.9", module_ "test-module" m]+ _ -> [] benchToBlock pkg benchName CondNode {..} =- deepseq condTreeConstraints $- Block- (Benchmark_ $ unUnqualComponentName benchName)- (benchDataToFields condTreeData ++- buildInfoToFields pkg (benchmarkBuildInfo condTreeData))- (nodesToBlocks pkg benchmarkBuildInfo benchDataToFields condTreeComponents)+ deepseq condTreeConstraints $+ Block+ (Benchmark_ $ unUnqualComponentName benchName)+ (benchDataToFields condTreeData +++ buildInfoToFields pkg (benchmarkBuildInfo condTreeData))+ (nodesToBlocks pkg benchmarkBuildInfo benchDataToFields condTreeComponents) benchDataToFields Benchmark {..} =- benchmarkName `seq`- case benchmarkInterface of- BenchmarkExeV10 v f ->- v `seq` [stringField "type" "exitcode-stdio-1.0", stringField "main-is" f]- _ -> []+ benchmarkName `seq`+ case benchmarkInterface of+ BenchmarkExeV10 v f ->+ v `seq` [stringField "type" "exitcode-stdio-1.0", stringField "main-is" f]+ _ -> [] nodesToBlocks pkg f renderMore = concatMap (condNodeToBlock pkg f renderMore) condNodeToBlock pkg getBuildInfo extra (CondBranch pred' branch1 branch2) =- let b1 =- deepseq (condTreeConstraints branch1) $- Block- (If pred')- (extra (condTreeData branch1) ++- buildInfoToFields pkg (getBuildInfo $ condTreeData branch1))- (nodesToBlocks pkg getBuildInfo extra (condTreeComponents branch1))- b2 =- branch2 <&> \b ->- deepseq (condTreeConstraints b) $- Block- Else- (extra (condTreeData b) ++- buildInfoToFields pkg (getBuildInfo $ condTreeData b))- (nodesToBlocks pkg getBuildInfo extra (condTreeComponents b))- in b1 : maybeToList b2+ let b1 =+ deepseq (condTreeConstraints branch1) $+ Block+ (If pred')+ (extra (condTreeData branch1) +++ buildInfoToFields pkg (getBuildInfo $ condTreeData branch1))+ (nodesToBlocks pkg getBuildInfo extra (condTreeComponents branch1))+ b2 =+ branch2 <&> \b ->+ deepseq (condTreeConstraints b) $+ Block+ Else+ (extra (condTreeData b) +++ buildInfoToFields pkg (getBuildInfo $ condTreeData b))+ (nodesToBlocks pkg getBuildInfo extra (condTreeComponents b))+ in b1 : maybeToList b2 buildInfoToFields _ BuildInfo {..} =- staticOptions `seq` -- staticOptions isn't in the parser yet- [ nonEmpty (commas "other-languages" . map show) otherLanguages- , nonEmpty (modules "other-modules") otherModules- , nonEmpty (modules "virtual-modules") virtualModules- , nonEmpty (mixins_ "mixins") mixins- , nonEmpty (modules "autogen-modules") autogenModules- , nonEmpty (commas "hs-source-dirs") hsSourceDirs- , buildDeps targetBuildDepends- , stringField "default-language" . show =<< defaultLanguage- , nonEmpty (extensions "default-extensions") defaultExtensions- , nonEmpty (extensions "extensions") oldExtensions- , nonEmpty (extensions "other-extensions") otherExtensions- , nonEmpty (commas "extra-library-flavours") extraLibFlavours- , nonEmpty (commas "extra-libraries") extraLibs- , nonEmpty (commas "extra-ghci-libraries") extraGHCiLibs- , nonEmpty (commas "extra-bundled-libraries") extraBundledLibs- , nonEmpty (pcDepends "pkgconfig-depends") pkgconfigDepends- , nonEmpty (commas "frameworks") frameworks- , nonEmpty (commas "extra-framework-dirs") extraFrameworkDirs- , nonEmpty (spaces "cc-options") ccOptions- , nonEmpty (spaces "cxx-options") cxxOptions- , nonEmpty (spaces "cmm-options") cmmOptions- , nonEmpty (spaces "asm-options") asmOptions- , nonEmpty (spaces "cpp-options") cppOptions- , nonEmpty (spaces "ld-options") ldOptions- , nonEmpty (commas "js-sources") jsSources- , nonEmpty (commas "cxx-sources") cxxSources- , nonEmpty (commas "c-sources") cSources- , nonEmpty (commas "cmm-sources") cmmSources- , nonEmpty (commas "asm-sources") asmSources- , nonEmpty (commas "extra-lib-dirs") extraLibDirs- , nonEmpty (commas "includes") includes- , nonEmpty (commas "install-includes") installIncludes- , nonEmpty (commas "include-dirs") includeDirs- , ffilter not (stringField "buildable" . show) buildable- , nonEmpty (toolDepends "build-tool-depends") newTools- , nonEmpty (oldToolDepends "build-tools") oldTools- ] ++- map (optionToField "") options ++- map (optionToField "-prof") profOptions ++- map (optionToField "-shared") sharedOptions ++- map (uncurry stringField) customFieldsBI+ staticOptions `seq` -- staticOptions isn't in the parser yet+ [ nonEmpty (commas "other-languages" . map show) otherLanguages+ , nonEmpty (modules "other-modules") otherModules+ , nonEmpty (modules "virtual-modules") virtualModules+ , nonEmpty (mixins_ "mixins") mixins+ , nonEmpty (modules "autogen-modules") autogenModules+ , nonEmpty (commas "hs-source-dirs") hsSourceDirs+ , buildDeps targetBuildDepends+ , stringField "default-language" . show =<< defaultLanguage+ , nonEmpty (extensions "default-extensions") defaultExtensions+ , nonEmpty (extensions "extensions") oldExtensions+ , nonEmpty (extensions "other-extensions") otherExtensions+ , nonEmpty (commas "extra-library-flavours") extraLibFlavours+ , nonEmpty (commas "extra-libraries") extraLibs+ , nonEmpty (commas "extra-ghci-libraries") extraGHCiLibs+ , nonEmpty (commas "extra-bundled-libraries") extraBundledLibs+ , nonEmpty (pcDepends "pkgconfig-depends") pkgconfigDepends+ , nonEmpty (commas "frameworks") frameworks+ , nonEmpty (commas "extra-framework-dirs") extraFrameworkDirs+ , nonEmpty (spaces "cc-options") ccOptions+ , nonEmpty (spaces "cxx-options") cxxOptions+ , nonEmpty (spaces "cmm-options") cmmOptions+ , nonEmpty (spaces "asm-options") asmOptions+ , nonEmpty (spaces "cpp-options") cppOptions+ , nonEmpty (spaces "ld-options") ldOptions+ , nonEmpty (commas "js-sources") jsSources+ , nonEmpty (commas "cxx-sources") cxxSources+ , nonEmpty (commas "c-sources") cSources+ , nonEmpty (commas "cmm-sources") cmmSources+ , nonEmpty (commas "asm-sources") asmSources+ , nonEmpty (commas "extra-lib-dirs") extraLibDirs+ , nonEmpty (commas "includes") includes+ , nonEmpty (commas "install-includes") installIncludes+ , nonEmpty (commas "include-dirs") includeDirs+ , ffilter not (stringField "buildable" . show) buildable+ , nonEmpty (toolDepends "build-tool-depends") newTools+ , nonEmpty (oldToolDepends "build-tools") oldTools+ ] +++ map (optionToField "") options +++ map (optionToField "-prof") profOptions +++ map (optionToField "-shared") sharedOptions ++ map (uncurry stringField) customFieldsBI where (oldTools, newTools) = (buildTools, buildToolDepends)
src/Types/Block.hs view
@@ -7,23 +7,23 @@ type File = ([Maybe Field], [Block]) data Block = Block- { title :: BlockHead- , fields :: [Maybe Field]- , subBlocks :: [Block]- } deriving (Show)+ { title :: BlockHead+ , fields :: [Maybe Field]+ , subBlocks :: [Block]+ } deriving (Show) data BlockHead- = If (Condition ConfVar)- | Else- | Benchmark_ String- | TestSuite_ String- | Exe_ String- | Library_ (Maybe String)- | ForeignLib_ String- | Flag_ String- | SourceRepo_ RepoKind- | CustomSetup- deriving (Show)+ = If (Condition ConfVar)+ | Else+ | Benchmark_ String+ | TestSuite_ String+ | Exe_ String+ | Library_ (Maybe String)+ | ForeignLib_ String+ | Flag_ String+ | SourceRepo_ RepoKind+ | CustomSetup+ deriving (Show) isElse Else = True isElse _ = False
src/Types/Field.hs view
@@ -1,35 +1,35 @@-{-# Language NoMonomorphismRestriction #-}+{-# LANGUAGE NoMonomorphismRestriction #-} module Types.Field- ( Field(..)- , FieldVal(..)- , extensions- , rexpModules- , flibOptions- , file- , flibType- , fieldName- , spaces- , commas- , toolDepends- , oldToolDepends- , pcDepends- , buildDeps- , modules- , module_- , mixins_- , desc- , version- , cabalVersion- , longList- , testedField- , licenseField- , spdxLicenseField- , dependencies- , nonEmpty- , stringField- , ffilter- ) where+ ( Field(..)+ , FieldVal(..)+ , extensions+ , rexpModules+ , flibOptions+ , file+ , flibType+ , fieldName+ , spaces+ , commas+ , toolDepends+ , oldToolDepends+ , pcDepends+ , buildDeps+ , modules+ , module_+ , mixins_+ , desc+ , version+ , cabalVersion+ , longList+ , testedField+ , licenseField+ , spdxLicenseField+ , dependencies+ , nonEmpty+ , stringField+ , ffilter+ ) where import Distribution.Compiler import Distribution.License@@ -45,39 +45,39 @@ import Distribution.Types.PkgconfigDependency import Distribution.Version import Documentation.Haddock.Parser-import Documentation.Haddock.Types (_doc, DocH)+import Documentation.Haddock.Types (DocH, _doc) import Language.Haskell.Extension import Prelude.Compat data FieldVal- = Dependencies [Dependency]- | Version Version- | CabalVersion (Either Version VersionRange)- | License License- | SPDXLicense SPDX.LicenseExpression- | Str String- | File String- | Spaces [String]- | Commas [String]- | LongList [String]- | Extensions [Extension]- | Modules [ModuleName]- | Module ModuleName- | RexpModules [ModuleReexport]- | TestedWith [(CompilerFlavor, VersionRange)]- | ToolDepends [ExeDependency]- | OldToolDepends [LegacyExeDependency]- | PcDepends [PkgconfigDependency]- | Mixins [Mixin]- | FlibType ForeignLibType- | FlibOptions [ForeignLibOption]- deriving (Show)+ = Dependencies [Dependency]+ | Version Version+ | CabalVersion (Either Version VersionRange)+ | License License+ | SPDXLicense SPDX.LicenseExpression+ | Str String+ | File String+ | Spaces [String]+ | Commas [String]+ | LongList [String]+ | Extensions [Extension]+ | Modules [ModuleName]+ | Module ModuleName+ | RexpModules [ModuleReexport]+ | TestedWith [(CompilerFlavor, VersionRange)]+ | ToolDepends [ExeDependency]+ | OldToolDepends [LegacyExeDependency]+ | PcDepends [PkgconfigDependency]+ | Mixins [Mixin]+ | FlibType ForeignLibType+ | FlibOptions [ForeignLibOption]+ deriving (Show) data Field- = Description (DocH () Identifier)- | Field String- FieldVal- deriving (Show)+ = Description (DocH () Identifier)+ | Field String+ FieldVal+ deriving (Show) flibType n p = Just $ Field n (FlibType p) @@ -112,7 +112,8 @@ version n a = Just $ Field n (Version a) -cabalVersion _ (Right vr) | vr == anyVersion = Nothing+cabalVersion _ (Right vr)+ | vr == anyVersion = Nothing cabalVersion n a = Just $ Field n (CabalVersion a) modules n as = Just $ Field n (Modules as)@@ -122,8 +123,8 @@ testedField n a = Just $ Field n (TestedWith a) ffilter f g as- | not (f as) = Nothing- | otherwise = g as+ | not (f as) = Nothing+ | otherwise = g as nonEmpty = ffilter (not . null)
stylish-cabal.cabal view
@@ -1,5 +1,5 @@ name: stylish-cabal-version: 0.4.0.1+version: 0.4.1.0 synopsis: Format Cabal files description: A tool for nicely formatting your Cabal file. license: BSD3@@ -7,7 +7,7 @@ author: Jude Taylor maintainer: me@jude.xyz tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2,- GHC == 8.2.2, GHC == 8.4.1, GHC == 8.5.*+ GHC == 8.2.2, GHC == 8.4.3 category: Language build-type: Simple extra-source-files: ChangeLog.md@@ -48,7 +48,7 @@ build-depends: base == 4.* , Cabal ^>= 2.2 , ansi-wl-pprint- , base-compat+ , base-compat == 0.10.* , data-default , deepseq , haddock-library ^>= 1.5@@ -77,7 +77,7 @@ , base-compat , containers , haddock-library- , hspec < 2.5+ , hspec >= 2.5 , hspec-core , microlens , microlens-th
tests/utils/Expectations.hs view
@@ -25,22 +25,10 @@ ([], Right new) = fmap sortGenericPackageDescription <$> parse' rendered shouldBe original new Warn {} ->- expectationFailure- "SKIP Warnings generated from original file, cannot guarantee consistency of output"- S.Error {} -> expectationFailure "SKIP Original cabal file does not parse"+ pendingWith+ "Warnings generated from original file, cannot guarantee consistency of output"+ S.Error {} -> pendingWith "Original cabal file does not parse" where parse' = runParseResult . parseGenericPackageDescription--applySkips i =- i- { itemExample =- \a b c -> do- res <- itemExample i a b c- case res of- Right (Failure _ (Reason r))- | "SKIP " `isPrefixOf` r ->- pure $ Right $ Pending $ Just $ drop 5 r- x -> return x- } mkHeader n p = "parses #" ++ show n ++ ": " ++ p