diff --git a/src/Parse.hs b/src/Parse.hs
--- a/src/Parse.hs
+++ b/src/Parse.hs
@@ -1,5 +1,4 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE CPP #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
@@ -12,65 +11,52 @@
, printWarnings
, Result(..)
, result
- ) where
-
-import Control.DeepSeq
-import Control.Monad.Compat
-import Data.Data
-import Data.Maybe
-import Distribution.PackageDescription
-import Distribution.PackageDescription.Parsec
- ( parseGenericPackageDescription
- , runParseResult
)
-import Distribution.Parsec.Common
-import Distribution.Simple.Utils
-import Distribution.Verbosity
-import Distribution.Version
-import GHC.Generics
-import Prelude.Compat
-import System.Exit
-#if MIN_VERSION_base(4,9,0)
-import Data.Functor.Classes
-#endif
+where
+
+import Control.DeepSeq
+import Control.Monad.Compat
+import Data.Data
+import Data.Maybe
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Parsec
+ ( parseGenericPackageDescription
+ , runParseResult
+ )
+import Distribution.Parsec.Common
+import Distribution.Simple.Utils
+import Distribution.Verbosity
+import Distribution.Version
+import GHC.Generics
+import Prelude.Compat
+import System.Exit
+import Data.Functor.Classes
+
-- | 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)
-#if MIN_VERSION_base(4,6,0)
-deriving instance Generic1 Result
-#endif
-
-#if !MIN_VERSION_base(4,8,0)
-deriving instance Typeable PError
-
-deriving instance Typeable Position
-
-deriving instance Typeable PWarnType
-#endif
+ deriving (Show, Eq, Functor, Generic, Typeable, Data, Generic1)
-#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
-#endif
+ 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
+
-- | 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
+result e w s p = case p of
+ Error l -> e l
+ Warn ws -> w ws
+ Success r -> s r
deriving instance Data PError
@@ -95,32 +81,34 @@
-- it safe here.
parsePackageDescription input =
let (warnings, r) = runParseResult $ parseGenericPackageDescription input
- in case r of
+ in case r of
Left (_, errors) -> Error errors
- Right x
- | null warnings -> parseResult x
- | otherwise -> Warn warnings
+ 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
- versWarning =
- "File does not specify a cabal-version. stylish-cabal requires at least 1.2"
+ versWarning
+ = "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.
+-- | Print some warnings to 'System.IO.stderr' and exit.
printWarnings :: Maybe FilePath -> [PWarning] -> IO a
printWarnings fpath ps =
- mapM_ (warn normal . showPWarning (fromMaybe "" fpath)) ps >> exitFailure
+ mapM_ (warn normal . showPWarning (fromMaybe "" fpath)) ps
+ >> exitFailure
--- | Print a parse error to 'stderr', annotated with filepath if available,
+-- | Print a parse error to 'System.IO.stderr', annotated with filepath if available,
-- then exit.
displayError :: Maybe FilePath -> [PError] -> IO a
displayError fpath warns =
- mapM_ (warn normal . showPError (fromMaybe "" fpath)) warns >> exitFailure
+ mapM_ (warn normal . showPError (fromMaybe "" fpath)) warns
+ >> exitFailure
diff --git a/src/Render.hs b/src/Render.hs
--- a/src/Render.hs
+++ b/src/Render.hs
@@ -89,7 +89,7 @@
deps lsep =
enclose (string lsep) empty $
hcat $
- intersperse (hardline <> string ", ") $ map showField $ sortBy (comparing fst) bs
+ intersperse (hardline <> string ", ") $ map showField $ sortOn fst bs
longest = maximum $ map (length . unP . fst) bs
hasRequires = any (\(_, c) -> not (isDefaultRenaming $ includeRequiresRn c)) bs
showField (P fName, i@IncludeRenaming {..})
@@ -130,7 +130,7 @@
| otherwise = fmap (\r -> colon <> indent (k - 1) r) (deps " ")
where
deps lsep = do
- fs <- mapM showField $ sortBy (comparing fst) bs
+ fs <- mapM showField $ sortOn fst bs
return $ encloseSep (string lsep) empty (string ", ") fs
longest = maximum $ map (length . unP . fst) bs
showField (P fName, fieldVal)
diff --git a/src/Render/Lib.hs b/src/Render/Lib.hs
--- a/src/Render/Lib.hs
+++ b/src/Render/Lib.hs
@@ -11,25 +11,29 @@
, renderTestedWith
, exeDependencyAsDependency
, renderDescription
- ) where
+ )
+where
-import Data.Char
-import Data.List.Compat
-import Data.Monoid.Compat
-import Distribution.Compiler
-import Distribution.ModuleName
-import Distribution.PackageDescription
-import Distribution.Pretty
-import Distribution.Types.ExeDependency
-import Distribution.Types.PackageName
-import Distribution.Types.UnqualComponentName
-import Distribution.Version
-import Prelude.Compat
-import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
+import Data.Char
+import Data.List.Compat
+import Data.Monoid.Compat
+import Distribution.Compiler
+import Distribution.ModuleName
+import Distribution.PackageDescription
+import Distribution.Pretty
+import Distribution.Types.ExeDependency
+import Distribution.Types.PackageName
+import Distribution.Types.UnqualComponentName
+import Distribution.Version
+import Prelude.Compat
+import Text.PrettyPrint.ANSI.Leijen
+ hiding ( (<$>)
+ , (<>)
+ )
-import Render.Lib.Haddock (renderDescription)
-import Render.Options
-import Types.Block
+import Render.Lib.Haddock ( renderDescription )
+import Render.Options
+import Types.Block
newtype P = P
{ unP :: String
@@ -37,103 +41,109 @@
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") _ = 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
- showCompiler x = show x
+ showCompiler (HaskellSuite x) = x
+ showCompiler x = show x
showVersioned :: (String, VersionRange) -> Render Doc
-showVersioned (pn, v')
- | v' == anyVersion = pure $ string pn
- | otherwise = fmap (string pn <+>) (showVersionRange v')
+showVersioned (pn, 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
+ return
+ $ cataVersionRange fold'
+ $ (if simplifyVersions opts then simplifyVersionRange else id) r
where
- fold' AnyVersionF = empty
- fold' (ThisVersionF v) = green "==" <+> dullyellow (string (prettyShow v))
+ fold' AnyVersionF = empty
+ fold' (ThisVersionF v) = green "==" <+> dullyellow (string (prettyShow v))
fold' (LaterVersionF v) = green ">" <+> dullyellow (string (prettyShow v))
- fold' (OrLaterVersionF v) = green ">=" <+> dullyellow (string (prettyShow v))
- fold' (EarlierVersionF v) = green "<" <+> dullyellow (string (prettyShow v))
- fold' (OrEarlierVersionF v) = green "<=" <+> dullyellow (string (prettyShow v))
- fold' (WildcardVersionF v) = green "==" <+> dullyellow (string (prettyShow v) <> ".*")
- fold' (MajorBoundVersionF v) = green "^>=" <+> dullyellow (string (prettyShow v))
- fold' (UnionVersionRangesF a b) = a <+> green "||" <+> b
+ fold' (OrLaterVersionF v) =
+ green ">=" <+> dullyellow (string (prettyShow v))
+ fold' (EarlierVersionF v) =
+ green "<" <+> dullyellow (string (prettyShow v))
+ fold' (OrEarlierVersionF v) =
+ green "<=" <+> dullyellow (string (prettyShow v))
+ fold' (WildcardVersionF v) =
+ green "==" <+> dullyellow (string (prettyShow v) <> ".*")
+ fold' (MajorBoundVersionF v) =
+ green "^>=" <+> dullyellow (string (prettyShow v))
+ fold' (UnionVersionRangesF a b) = a <+> green "||" <+> b
fold' (IntersectVersionRangesF a b) = a <+> green "&&" <+> b
- fold' (VersionRangeParensF a) = parens a
+ fold' (VersionRangeParensF a ) = parens a
filepath :: String -> Doc
-filepath x
- | null x = string "\"\""
- | any isSpace x = string $ show x
- | otherwise = string x
+filepath 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)
renderBlockHead (If c) = (dullblue "if" <+>) <$> showPredicate c
-renderBlockHead x = pure $ r x
+renderBlockHead x = pure $ r x
where
- r CustomSetup = dullgreen "custom-setup"
+ r CustomSetup = dullgreen "custom-setup"
r (SourceRepo_ k) = dullgreen "source-repository" <+> showKind k
where
- showKind RepoHead = "head"
- showKind RepoThis = "this"
+ showKind RepoHead = "head"
+ showKind RepoThis = "this"
showKind (RepoKindUnknown y) = string y
- r (Library_ Nothing) = dullgreen "library"
- r (Library_ (Just l)) = dullgreen "library" <+> string l
- r (ForeignLib_ l) = dullgreen "foreign-library" <+> string l
- r (Exe_ e) = dullgreen "executable" <+> string e
- r (TestSuite_ t) = dullgreen "test-suite" <+> string t
- r (Benchmark_ b) = dullgreen "benchmark" <+> string b
- r (Flag_ s) = dullgreen "flag" <+> string s
- r Else = dullblue "else"
- r _ = error "unreachable"
+ r (Library_ Nothing ) = dullgreen "library"
+ r (Library_ (Just l)) = dullgreen "library" <+> string l
+ r (ForeignLib_ l ) = dullgreen "foreign-library" <+> string l
+ r (Exe_ e ) = dullgreen "executable" <+> string e
+ r (TestSuite_ t ) = dullgreen "test-suite" <+> string t
+ r (Benchmark_ b ) = dullgreen "benchmark" <+> string b
+ r (Flag_ s ) = dullgreen "flag" <+> string s
+ r Else = dullblue "else"
+ r _ = error "unreachable"
showPredicate :: Condition ConfVar -> Render Doc
-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)
-showPredicate (COr a b) =
- liftM2 (\x y -> x <+> dullblue (string "||") <+> y) (maybeParens a) (maybeParens b)
+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)
+showPredicate (COr a 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
+maybeParens 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)
-showVar (Flag f) =
- pure $ dullgreen $ string "flag" <> parens (dullblue $ string (unFlagName f))
-showVar (OS 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)
+showVar (Flag f) = pure $ dullgreen $ string "flag" <> parens
+ (dullblue $ string (unFlagName f))
+showVar (OS 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)
diff --git a/src/Render/Lib/Haddock.hs b/src/Render/Lib/Haddock.hs
--- a/src/Render/Lib/Haddock.hs
+++ b/src/Render/Lib/Haddock.hs
@@ -4,15 +4,18 @@
module Render.Lib.Haddock where
-import Control.Monad.Reader
-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 Control.Monad.Reader
+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 ( (<$>)
+ , (<>)
+ )
data FlattenBehavior
= Flatten
@@ -29,13 +32,14 @@
, listContext :: Bool
}
-flattenedBody = withReader $ \d -> d {flattenBehavior = Flatten, textPosition = Body}
+flattenedBody =
+ withReader $ \d -> d { flattenBehavior = Flatten, textPosition = Body }
-inPara = withReader $ \d -> d {textPosition = ParaStart}
+inPara = withReader $ \d -> d { textPosition = ParaStart }
-inBody = withReader $ \d -> d {textPosition = Body}
+inBody = withReader $ \d -> d { textPosition = Body }
-inList = withReader $ \d -> d {listContext = True}
+inList = withReader $ \d -> d { listContext = True }
defaultDocContext = DocContext WordBreak ParaStart False
@@ -43,123 +47,126 @@
-- 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]
+ flatten d = [d]
-- flatten inline styling which the haddock parser doesn't preserve
-- across line boundaries
go :: DocH () Identifier -> Reader DocContext Doc
go DocEmpty = pure empty
- go (DocEmphasis d) = enclose (green "/") (green "/") <$> flattenedBody (go d)
- go (DocMonospaced d) = enclose (green "@") (green "@") <$> flattenedBody (go d)
+ go (DocEmphasis d) =
+ enclose (green "/") (green "/") <$> flattenedBody (go d)
+ 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)
- go (DocAppend a b) = liftM2 (<>) (go a) (inBody $ go b)
- go (DocParagraph d) = inPara $ go d
+ 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
+ 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
+ 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 "@"]
+ 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
+ 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
+ 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
+ go (DocExamples 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)
- go (DocMathDisplay x) = return $ enclose (green "\\[") (green "\\]") (strBody x)
- go (DocMathInline x) = return $ enclose (green "\\(") (green "\\)") (strBody 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))
- go (DocPic (Picture p t)) =
- return $
- enclose (green "<<") (green ">>") (string $ p ++ maybe "" (" " ++) (unNl <$> t))
+ go (DocHyperlink (Hyperlink h l)) = return $ enclose
+ (green "<")
+ (green ">")
+ (string $ h ++ maybe "" (" " ++) (unNl <$> l))
+ go (DocPic (Picture p 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)
- goplain (DocString s) = strPara $ escapeHtml s
+ unNl = 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)
goplain (DocEmphasis x) = enclose (green "/") (green "/") (goplain x)
- goplain (DocModule x) = enclose (green "\"") (green "\"") (string x)
- goplain n = error $ "Unhandled in goplain: " ++ show n
+ goplain (DocModule x) = enclose (green "\"") (green "\"") (string x)
+ goplain n = error $ "Unhandled in goplain: " ++ show n
-map2 f g (x:xs) = f x : map g xs
-map2 _ _ [] = []
+map2 f g (x : xs) = f x : map g xs
+map2 _ _ [] = []
-arrowblock ('\n':ys) = line <> green "> " <> arrowblock ys
-arrowblock (x:xs) = char x <> arrowblock xs
-arrowblock "" = empty
+arrowblock ('\n' : ys) = line <> green "> " <> arrowblock ys
+arrowblock (x : xs) = char x <> arrowblock xs
+arrowblock "" = empty
-escapeHtml "" = ""
-escapeHtml ('\n':'\n':xs) = '\n' : '.' : '\n' : escapeHtml xs
-escapeHtml ('\n':xs)
- | (spcs, '-':chrs) <- span isSpace xs = '\n' : spcs ++ ('\1' : '-' : escapeHtml chrs)
-escapeHtml (c:cs) = c : escapeHtml cs
+escapeHtml "" = ""
+escapeHtml ('\n' : '\n' : xs) = '\n' : '.' : '\n' : escapeHtml xs
+escapeHtml ('\n' : xs) | (spcs, '-' : chrs) <- span isSpace xs =
+ '\n' : spcs ++ ('\1' : '-' : escapeHtml chrs)
+escapeHtml (c : cs) = c : escapeHtml cs
-strPara ('>':'>':'>':cs) = text "\\>>>" <> strBody cs
-strPara (x: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
+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
strBody "" = empty
diff --git a/src/Render/Options.hs b/src/Render/Options.hs
--- a/src/Render/Options.hs
+++ b/src/Render/Options.hs
@@ -5,14 +5,18 @@
module Render.Options
( module Render.Options
, module Control.Monad.Reader
- ) where
+ )
+where
-import Control.Monad.Reader hiding (mapM)
-import Data.Data
-import Data.Default
-import GHC.Generics
-import Prelude.Compat
-import Text.PrettyPrint.ANSI.Leijen (Doc, indent, width)
+import Control.Monad.Reader hiding ( mapM )
+import Data.Data
+import Data.Default
+import GHC.Generics
+import Prelude.Compat
+import Text.PrettyPrint.ANSI.Leijen ( Doc
+ , indent
+ , width
+ )
type Render = Reader RenderOptions
@@ -27,7 +31,7 @@
} 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
diff --git a/src/StylishCabal.hs b/src/StylishCabal.hs
--- a/src/StylishCabal.hs
+++ b/src/StylishCabal.hs
@@ -21,19 +21,24 @@
, plain
, displayIO
, displayS
- ) where
+ )
+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 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 Parse
-import Render
-import Render.Options
-import Transform
+import Parse
+import Render
+import Render.Options
+import Transform
-- | @pretty pkg@ produces a colorized, formatted textual representation of
-- a given 'Distribution.PackageDescription.GenericPackageDescription',
@@ -45,7 +50,8 @@
-- | 'pretty' with specified options.
prettyOpts :: RenderOptions -> GenericPackageDescription -> Doc
-prettyOpts opts gpd = runReader (uncurry blockBodyToDoc $ toBlocks gpd) opts <> line
+prettyOpts opts gpd =
+ runReader (uncurry blockBodyToDoc $ toBlocks gpd) opts <> line
-- | Render the given 'Doc' with the given width.
render :: Int -> Doc -> SimpleDoc
diff --git a/src/Transform.hs b/src/Transform.hs
--- a/src/Transform.hs
+++ b/src/Transform.hs
@@ -3,186 +3,190 @@
module Transform
( toBlocks
- ) where
+ )
+where
-import Control.Arrow
-import Control.DeepSeq
-import Control.Monad
-import Data.Char
-import Data.Maybe
-import Distribution.License
-import Distribution.PackageDescription
-import Distribution.Types.CondTree
-import Distribution.Types.ExecutableScope
-import Distribution.Types.ForeignLib
-import Distribution.Types.ForeignLibType
-import Distribution.Types.PackageId
-import Distribution.Types.PackageName
-import Distribution.Types.UnqualComponentName
-import Distribution.Version
-import Prelude.Compat
+import Control.Arrow
+import Control.DeepSeq
+import Control.Monad
+import Data.Char
+import Data.Maybe
+import Distribution.License
+import Distribution.PackageDescription
+import Distribution.Types.CondTree
+import Distribution.Types.ExecutableScope
+import Distribution.Types.ForeignLib
+import Distribution.Types.ForeignLibType
+import Distribution.Types.PackageId
+import Distribution.Types.PackageName
+import Distribution.Types.UnqualComponentName
+import Distribution.Version
+import Prelude.Compat
-import Types.Block
-import Types.Field
+import Types.Block
+import Types.Field
(<&>) = 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
- ])
+ [ 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 {..}
+setupBuildInfoToBlock SetupBuildInfo {..} =
+ defaultSetupDepends
+ `seq` Block CustomSetup
+ [nonEmpty (dependencies "setup-depends") setupDepends]
+ []
-- defaultSetupDepends doesn't correspond to anything in the cabal file
- =
- 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
- ]
- []
+sourceRepoToBlock SourceRepo {..} = 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
+ 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
+ , 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
- license' [] = Nothing
+ license' [] = Nothing
license' [l] = file "license-file" l
- license' ls = commas "license-files" ls
+ license' ls = commas "license-files" ls
-flagToBlock MkFlag {..} =
- Block
- (Flag_ (unFlagName flagName))
- [ stringField "default" (show flagDefault)
- , ffilter id (stringField "manual" . show) flagManual
- , desc flagDescription
- ]
- []
+flagToBlock MkFlag {..} = 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)
+libToBlock pkg libname CondNode {..} = 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
+ condTreeConstraints `deepseq` Block
(ForeignLib_ $ unUnqualComponentName libname)
- (foreignLibDataToFields condTreeData ++
- buildInfoToFields pkg (foreignLibBuildInfo condTreeData))
- (nodesToBlocks pkg foreignLibBuildInfo foreignLibDataToFields condTreeComponents)
+ ( 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
+ 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)
+exeToBlock pkg exeName CondNode {..} = 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)
+testToBlock pkg testName CondNode {..} = 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]
- _ -> []
+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]
+ _ -> []
-benchToBlock pkg benchName CondNode {..} =
- deepseq condTreeConstraints $
- Block
- (Benchmark_ $ unUnqualComponentName benchName)
- (benchDataToFields condTreeData ++
- buildInfoToFields pkg (benchmarkBuildInfo condTreeData))
- (nodesToBlocks pkg benchmarkBuildInfo benchDataToFields condTreeComponents)
+benchToBlock pkg benchName CondNode {..} = deepseq condTreeConstraints $ Block
+ (Benchmark_ $ unUnqualComponentName benchName)
+ ( benchDataToFields condTreeData
+ ++ buildInfoToFields pkg (benchmarkBuildInfo condTreeData)
+ )
+ (nodesToBlocks pkg benchmarkBuildInfo benchDataToFields condTreeComponents)
benchDataToFields Benchmark {..} =
- benchmarkName `seq`
- case benchmarkInterface of
+ benchmarkName `seq` case benchmarkInterface of
BenchmarkExeV10 v f ->
v `seq` [stringField "type" "exitcode-stdio-1.0", stringField "main-is" f]
_ -> []
@@ -190,66 +194,65 @@
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
- where
- (oldTools, newTools) = (buildTools, buildToolDepends)
+ 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)
-optionToField pref (f, args) = spaces (map toLower (show f) ++ pref ++ "-options") args
+optionToField pref (f, args) =
+ spaces (map toLower (show f) ++ pref ++ "-options") args
diff --git a/src/Types/Block.hs b/src/Types/Block.hs
--- a/src/Types/Block.hs
+++ b/src/Types/Block.hs
@@ -1,8 +1,8 @@
module Types.Block where
-import Distribution.PackageDescription
-import Prelude.Compat
-import Types.Field
+import Distribution.PackageDescription
+import Prelude.Compat
+import Types.Field
type File = ([Maybe Field], [Block])
@@ -26,4 +26,4 @@
deriving (Show)
isElse Else = True
-isElse _ = False
+isElse _ = False
diff --git a/src/Types/Field.hs b/src/Types/Field.hs
--- a/src/Types/Field.hs
+++ b/src/Types/Field.hs
@@ -29,25 +29,28 @@
, nonEmpty
, stringField
, ffilter
- ) where
+ )
+where
-import Distribution.Compiler
-import Distribution.License
-import Distribution.ModuleName
-import qualified Distribution.SPDX as SPDX
-import Distribution.Types.Dependency
-import Distribution.Types.ExeDependency
-import Distribution.Types.ForeignLibOption
-import Distribution.Types.ForeignLibType
-import Distribution.Types.LegacyExeDependency
-import Distribution.Types.Mixin
-import Distribution.Types.ModuleReexport
-import Distribution.Types.PkgconfigDependency
-import Distribution.Version
-import Documentation.Haddock.Parser
-import Documentation.Haddock.Types (DocH, _doc)
-import Language.Haskell.Extension
-import Prelude.Compat
+import Distribution.Compiler
+import Distribution.License
+import Distribution.ModuleName
+import qualified Distribution.SPDX as SPDX
+import Distribution.Types.Dependency
+import Distribution.Types.ExeDependency
+import Distribution.Types.ForeignLibOption
+import Distribution.Types.ForeignLibType
+import Distribution.Types.LegacyExeDependency
+import Distribution.Types.Mixin
+import Distribution.Types.ModuleReexport
+import Distribution.Types.PkgconfigDependency
+import Distribution.Version
+import Documentation.Haddock.Parser
+import Documentation.Haddock.Types ( DocH
+ , _doc
+ )
+import Language.Haskell.Extension
+import Prelude.Compat
data FieldVal
= Dependencies [Dependency]
@@ -97,7 +100,7 @@
licenseField n a = Just $ Field n (License a)
-spdxLicenseField _ SPDX.NONE = Nothing
+spdxLicenseField _ SPDX.NONE = Nothing
spdxLicenseField n (SPDX.License a) = Just $ Field n (SPDXLicense a)
file n a = Just $ Field n (File a)
@@ -112,9 +115,8 @@
version n a = Just $ Field n (Version a)
-cabalVersion _ (Right vr)
- | vr == anyVersion = Nothing
-cabalVersion n a = Just $ Field n (CabalVersion a)
+cabalVersion _ (Right vr) | vr == anyVersion = Nothing
+cabalVersion n a = Just $ Field n (CabalVersion a)
modules n as = Just $ Field n (Modules as)
@@ -122,17 +124,16 @@
testedField n a = Just $ Field n (TestedWith a)
-ffilter f g as
- | not (f as) = Nothing
- | otherwise = g as
+ffilter f g as | not (f as) = Nothing
+ | otherwise = g as
nonEmpty = ffilter (not . null)
-fieldName (Field s _) = s
+fieldName (Field s _ ) = s
fieldName (Description _) = "description"
desc [] = Nothing
-desc vs = Just (Description $ _doc $ parseParas vs)
+desc vs = Just (Description $ _doc $ parseParas Nothing vs)
buildDeps [] = Nothing
buildDeps vs = dependencies "build-depends" vs
diff --git a/stylish-cabal.cabal b/stylish-cabal.cabal
--- a/stylish-cabal.cabal
+++ b/stylish-cabal.cabal
@@ -1,13 +1,12 @@
name: stylish-cabal
-version: 0.4.1.0
+version: 0.5.0.0
synopsis: Format Cabal files
description: A tool for nicely formatting your Cabal file.
license: BSD3
license-file: LICENSE
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.3
+tested-with: GHC == 8.6.1
category: Language
build-type: Simple
extra-source-files: ChangeLog.md
@@ -31,8 +30,7 @@
flag test-strictness
default: False
manual: True
- description: Run the strictness testsuite. This requires the StrictCheck package which
- is not yet on Hackage, and thus is disabled by default.
+ description: Run the strictness testsuite. (Used to verify that the entire package description is processed.)
library
exposed-modules: StylishCabal
@@ -46,12 +44,12 @@
Types.Field
hs-source-dirs: src
build-depends: base == 4.*
- , Cabal ^>= 2.2
+ , Cabal ^>= 2.4
, ansi-wl-pprint
- , base-compat == 0.10.*
+ , base-compat
, data-default
, deepseq
- , haddock-library ^>= 1.5
+ , haddock-library ^>= 1.7
, microlens
, mtl
, split
@@ -59,9 +57,6 @@
default-extensions: NoMonomorphismRestriction
NoImplicitPrelude
ghc-options: -Wall -fno-warn-missing-signatures
-
- if impl(ghc < 7.6)
- build-depends: ghc-prim
if flag(werror)
ghc-options: -Werror
diff --git a/tests/utils/Expectations.hs b/tests/utils/Expectations.hs
--- a/tests/utils/Expectations.hs
+++ b/tests/utils/Expectations.hs
@@ -1,34 +1,37 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# Language StandaloneDeriving #-}
module Expectations where
-import qualified Data.ByteString.UTF8 as U
-import Data.List.Compat
-import Distribution.PackageDescription.Parsec
-import Prelude.Compat
-import SortedPackageDescription
-import StylishCabal as S
-import Test.Hspec
-import Test.Hspec.Core.Spec
-import Test.Hspec.Core.Runner
+import qualified Data.ByteString.UTF8 as U
+import Data.List.Compat
+import Distribution.PackageDescription.Parsec
+import Prelude.Compat
+import SortedPackageDescription
+import StylishCabal as S
+import Test.Hspec
+import Test.Hspec.Core.Runner
-hspecColor = hspecWith (defaultConfig {configColorMode = ColorAlways})
+hspecColor = hspecWith (defaultConfig { configColorMode = ColorAlways })
expectParse cabalStr = do
- let doc =
- U.fromString . (`displayS` "") . render 80 . plain . pretty <$>
- S.parsePackageDescription cabalStr
- case doc of
- S.Success rendered -> do
- let ([], Right original) = fmap sortGenericPackageDescription <$> parse' cabalStr
- ([], Right new) = fmap sortGenericPackageDescription <$> parse' rendered
- shouldBe original new
- Warn {} ->
- pendingWith
- "Warnings generated from original file, cannot guarantee consistency of output"
- S.Error {} -> pendingWith "Original cabal file does not parse"
- where
- parse' = runParseResult . parseGenericPackageDescription
+ let doc =
+ U.fromString
+ . (`displayS` "")
+ . render 80
+ . plain
+ . pretty
+ <$> S.parsePackageDescription cabalStr
+ case doc of
+ S.Success rendered -> do
+ let ([], Right original) =
+ fmap sortGenericPackageDescription <$> parse' cabalStr
+ ([], Right new) =
+ fmap sortGenericPackageDescription <$> parse' rendered
+ shouldBe original new
+ Warn{} ->
+ pendingWith
+ "Warnings generated from original file, cannot guarantee consistency of output"
+ S.Error{} -> pendingWith "Original cabal file does not parse"
+ where parse' = runParseResult . parseGenericPackageDescription
mkHeader n p = "parses #" ++ show n ++ ": " ++ p
diff --git a/tests/utils/MultiSet.hs b/tests/utils/MultiSet.hs
--- a/tests/utils/MultiSet.hs
+++ b/tests/utils/MultiSet.hs
@@ -2,9 +2,9 @@
module MultiSet where
-import qualified Data.Map as M
-import Prelude.Compat
+import qualified Data.Map as M
+import Prelude.Compat
newtype MultiSet a = MultiSet { unMultiSet :: M.Map a Int } deriving (Eq, Ord, Show)
-fromList = MultiSet . foldr (\ v -> M.insertWith (+) v 1) M.empty
+fromList = MultiSet . foldr (\v -> M.insertWith (+) v 1) M.empty
diff --git a/tests/utils/SortedPackageDescription.hs b/tests/utils/SortedPackageDescription.hs
--- a/tests/utils/SortedPackageDescription.hs
+++ b/tests/utils/SortedPackageDescription.hs
@@ -10,47 +10,48 @@
{-# Language TypeFamilies #-}
module SortedPackageDescription
- ( Sortable(..)
- , sortGenericPackageDescription
- , MkSortGenericPackageDescription(..)
- ) where
+ ( Sortable(..)
+ , sortGenericPackageDescription
+ , MkSortGenericPackageDescription(..)
+ )
+where
-import Data.Char (isSpace)
-import Data.List (sortBy)
-import Data.List.Split
-import Data.Ord (comparing)
-import Data.Word
-import Distribution.Compiler
-import Distribution.License
-import Distribution.ModuleName
-import Distribution.PackageDescription
-import qualified Distribution.SPDX as SPDX
-import Distribution.System
-import Distribution.Types.CondTree
-import Distribution.Types.Dependency
-import Distribution.Types.ExeDependency
-import Distribution.Types.ExecutableScope
-import Distribution.Types.ForeignLib
-import Distribution.Types.ForeignLibOption
-import Distribution.Types.ForeignLibType
-import Distribution.Types.IncludeRenaming
-import Lens.Micro.TH
-import Lens.Micro
-import Distribution.Types.LegacyExeDependency
-import Distribution.Types.Mixin
-import Distribution.Types.PackageId
-import Distribution.Types.PackageName
-import Distribution.Types.PkgconfigDependency
-import Distribution.Types.PkgconfigName
-import Distribution.Types.UnqualComponentName
-import Distribution.Types.Version
-import Distribution.Types.VersionRange
-import Documentation.Haddock.Types hiding (Version)
-import Documentation.Haddock.Parser
-import Distribution.Utils.ShortText
-import Language.Haskell.Extension
-import Prelude.Compat
-import SortedPackageDescription.TH
+import Data.Char ( isSpace )
+import Data.List ( sortOn )
+import Data.List.Split
+import Data.Word
+import Distribution.Compiler
+import Distribution.License
+import Distribution.ModuleName
+import Distribution.PackageDescription
+import qualified Distribution.SPDX as SPDX
+import Distribution.System
+import Distribution.Types.CondTree
+import Distribution.Types.Dependency
+import Distribution.Types.ExeDependency
+import Distribution.Types.ExecutableScope
+import Distribution.Types.ForeignLib
+import Distribution.Types.ForeignLibOption
+import Distribution.Types.ForeignLibType
+import Distribution.Types.IncludeRenaming
+import Lens.Micro.TH
+import Lens.Micro
+import Distribution.Types.LegacyExeDependency
+import Distribution.Types.Mixin
+import Distribution.Types.PackageId
+import Distribution.Types.PackageName
+import Distribution.Types.PkgconfigDependency
+import Distribution.Types.PkgconfigName
+import Distribution.Types.UnqualComponentName
+import Distribution.Types.Version
+import Distribution.Types.VersionRange
+import Documentation.Haddock.Types
+ hiding ( Version )
+import Documentation.Haddock.Parser
+import Distribution.Utils.ShortText
+import Language.Haskell.Extension
+import Prelude.Compat
+import SortedPackageDescription.TH
deriving instance (Ord a, Ord b) => Ord (DocH a b)
@@ -75,53 +76,51 @@
[("description", "descriptionL"), ("synopsis", "synopsisL")]
''PackageDescription
-sortGenericPackageDescription ::
- GenericPackageDescription
- -> ([DocH () String], MkSortable GenericPackageDescription)
+sortGenericPackageDescription
+ :: GenericPackageDescription
+ -> ([DocH () String], MkSortable GenericPackageDescription)
sortGenericPackageDescription gpd = (descriptions, sortable desc)
where
(descriptions, desc) = extractDescs gpd
- flagDescriptionL = lens flagDescription (\f d -> f {flagDescription = d})
+ flagDescriptionL = lens flagDescription (\f d -> f { flagDescription = d })
extractDescs g =
- let (dsc, gpd1) = g & (packageDescriptionL . descriptionL) <<.~ ""
- (syn, gpd2) = gpd1 & (packageDescriptionL . synopsisL) <<.~ ""
- (fs, gpd3) =
- gpd2 &
- (genPackageFlagsL . traverse) (\x -> ([x], x {flagDescription = ""}))
- sortedFlags = sortBy (comparing flagName) fs
- in ( map (unNl . toRegular . _doc . parseParas) $
- dsc : syn : map flagDescription sortedFlags
- , gpd3)
+ let
+ (dsc, gpd1) = g & (packageDescriptionL . descriptionL) <<.~ ""
+ (syn, gpd2) = gpd1 & (packageDescriptionL . synopsisL) <<.~ ""
+ (fs, gpd3) =
+ gpd2 & (genPackageFlagsL . traverse)
+ (\x -> ([x], x { flagDescription = "" }))
+ sortedFlags = sortOn flagName fs
+ in
+ ( map (unNl . toRegular . _doc . parseParas Nothing)
+ $ dsc
+ : syn
+ : map flagDescription sortedFlags
+ , gpd3
+ )
unNl :: DocH () String -> DocH () String
unNl (DocString s) = DocString $ unwords $ wordsBy isSpace s
- unNl (DocEmphasis x) = DocEmphasis $ unNl x
- unNl (DocAppend a b) = DocAppend (unNl a) (unNl b)
- unNl (DocParagraph d) = DocParagraph $ unNl d
- unNl (DocBold d) = DocBold (unNl d)
- unNl (DocCodeBlock d) = DocCodeBlock $ unNl d
+ unNl (DocEmphasis x ) = DocEmphasis $ unNl x
+ unNl (DocAppend a b ) = DocAppend (unNl a) (unNl b)
+ unNl (DocParagraph d ) = DocParagraph $ unNl d
+ unNl (DocBold d ) = DocBold (unNl d)
+ unNl (DocCodeBlock d ) = DocCodeBlock $ unNl d
unNl (DocDefList bs) = DocDefList $ map (\(x, y) -> (unNl x, unNl y)) bs
- unNl (DocUnorderedList b) = DocUnorderedList (map unNl b)
- unNl (DocMonospaced d) = DocMonospaced (unNl d)
- unNl (DocOrderedList ds) = DocOrderedList (map unNl ds)
- unNl DocEmpty = DocEmpty
- unNl d@DocHeader {} = d
- unNl d@DocMathDisplay {} = d
- unNl d@DocExamples {} = d
- unNl d@DocPic {} = d
- unNl (DocHyperlink (Hyperlink h l)) =
- DocHyperlink $
- Hyperlink
- h
- (map (\x ->
- if x == '\n'
- then ' '
- else x) <$>
- l)
- unNl d@DocIdentifier {} = d
- unNl d@DocModule {} = d
- unNl d@DocMathInline {} = d
- unNl d@DocAName {} = d
- unNl x = error $ show x
+ unNl (DocUnorderedList b ) = DocUnorderedList (map unNl b)
+ unNl (DocMonospaced d ) = DocMonospaced (unNl d)
+ unNl (DocOrderedList ds) = DocOrderedList (map unNl ds)
+ unNl DocEmpty = DocEmpty
+ unNl d@DocHeader{} = d
+ unNl d@DocMathDisplay{} = d
+ unNl d@DocExamples{} = d
+ unNl d@DocPic{} = d
+ unNl (DocHyperlink (Hyperlink h l)) = DocHyperlink
+ $ Hyperlink h (map (\x -> if x == '\n' then ' ' else x) <$> l)
+ unNl d@DocIdentifier{} = d
+ unNl d@DocModule{} = d
+ unNl d@DocMathInline{} = d
+ unNl d@DocAName{} = d
+ unNl x = error $ show x
prim [''ModuleName, ''ShortText, ''Char, ''Word64, ''PackageName, ''Int, ''Bool]
@@ -181,8 +180,6 @@
, ''BenchmarkType
]
-deriving instance Ord SourceRepo
-
deriving instance (Ord a, Ord b, Ord c) => Ord (CondTree a b c)
deriving instance (Ord a, Ord b, Ord c) => Ord (CondBranch a b c)
@@ -248,12 +245,12 @@
(MkSortable (Condition c))
instance Sortable a => Sortable (Condition a) where
- type MkSortable (Condition a) = MkSortCondition a
- sortable (Var arg) = MkSortVar (sortable arg)
- sortable (Lit arg) = MkSortLit (sortable arg)
- sortable (CNot arg) = MkSortCNot (sortable arg)
- sortable (COr arg arg2) = MkSortCOr (sortable arg) (sortable arg2)
- sortable (CAnd arg arg2) = MkSortCAnd (sortable arg) (sortable arg2)
+ type MkSortable (Condition a) = MkSortCondition a
+ sortable (Var arg ) = MkSortVar (sortable arg)
+ sortable (Lit arg ) = MkSortLit (sortable arg)
+ sortable (CNot arg ) = MkSortCNot (sortable arg)
+ sortable (COr arg arg2) = MkSortCOr (sortable arg) (sortable arg2)
+ sortable (CAnd arg arg2) = MkSortCAnd (sortable arg) (sortable arg2)
data MkSortCondTree v c a = MkSortCondNode
{ mkSortCondTreeData :: MkSortable a
@@ -301,9 +298,9 @@
, Ord (MkSortable c)
) =>
Sortable (CondTree a b c) where
- type MkSortable (CondTree a b c) = MkSortCondTree a b c
- sortable (CondNode arg arg2 arg3) =
- MkSortCondNode (sortable arg) (sortable arg2) (sortable arg3)
+ type MkSortable (CondTree a b c) = MkSortCondTree a b c
+ sortable (CondNode arg arg2 arg3) =
+ MkSortCondNode (sortable arg) (sortable arg2) (sortable arg3)
data MkSortCondBranch v c a = MkSortCondBranch
{ mkSortCondBranchCondition :: MkSortable (Condition v)
@@ -319,8 +316,8 @@
, Ord (MkSortable c)
) =>
Sortable (CondBranch a b c) where
- type MkSortable (CondBranch a b c) = MkSortCondBranch a b c
- sortable (CondBranch arg arg2 arg3) =
- MkSortCondBranch (sortable arg) (sortable arg2) (sortable arg3)
+ type MkSortable (CondBranch a b c) = MkSortCondBranch a b c
+ sortable (CondBranch arg arg2 arg3) =
+ MkSortCondBranch (sortable arg) (sortable arg2) (sortable arg3)
deriveSortable [''GenericPackageDescription]
diff --git a/tests/utils/SortedPackageDescription/TH.hs b/tests/utils/SortedPackageDescription/TH.hs
--- a/tests/utils/SortedPackageDescription/TH.hs
+++ b/tests/utils/SortedPackageDescription/TH.hs
@@ -1,4 +1,3 @@
-{-# Language CPP #-}
{-# Language DefaultSignatures #-}
{-# Language FlexibleContexts #-}
{-# Language FlexibleInstances #-}
@@ -8,10 +7,6 @@
{-# Language TypeSynonymInstances #-}
{-# Language UndecidableInstances #-}
-#if __GLASGOW_HASKELL__ < 706
-{-# LANGUAGE ConstraintKinds #-}
-#endif
-
module SortedPackageDescription.TH where
import Control.Monad.Compat
@@ -54,28 +49,12 @@
[ instanceD
(cxt [])
[t|Sortable $(conT n)|]
-#if MIN_VERSION_template_haskell(2,9,0)
[ tySynInstD ''MkSortable (tySynEqn [conT n] (conT n))
-#else
- [ tySynInstD ''MkSortable [conT n] (conT n)
-#endif
, funD 'sortable [clause [] (normalB [|id|]) []]
]
]
-#if MIN_VERSION_template_haskell(2,11,0)
-#define KIND_ARG _k
-#else
-#define KIND_ARG
-#endif
-
-#if MIN_VERSION_template_haskell(2,12,0)
commonDerivClause = [derivClause Nothing [[t|Show|], [t|Ord|], [t|Eq|]]]
-#elif MIN_VERSION_template_haskell(2,11,0)
-commonDerivClause = cxt [[t|Show|], [t|Ord|], [t|Eq|]]
-#else
-commonDerivClause = [''Show, ''Ord, ''Eq]
-#endif
deriveSortable :: [Name] -> DecsQ
deriveSortable = deriveSortable_ ""
@@ -92,55 +71,37 @@
, instanceD
(cxt [])
[t|Sortable $(tyhead)|]
-#if MIN_VERSION_template_haskell(2,9,0)
[ tySynInstD ''MkSortable (tySynEqn [tyhead] (conT dty))
-#else
- [ tySynInstD ''MkSortable [tyhead] (conT dty)
-#endif
, funD 'sortable (mkSortableImpl prefix x)
]
]
-mkSortableDataD prefix (DataD cx tyName [] KIND_ARG cons _) =
+mkSortableDataD prefix (DataD cx tyName [] _k cons _) =
(,) newname <$>
- dataD (pure cx) newname [] KIND_ARG (map (mkSortableCon prefix) cons) commonDerivClause
+ dataD (pure cx) newname [] _k (map (mkSortableCon prefix) cons) commonDerivClause
where
newname = sortedTyName prefix tyName
-mkSortableDataD prefix (NewtypeD cx tyName [] KIND_ARG con _) =
+mkSortableDataD prefix (NewtypeD cx tyName [] _k con _) =
(,) newname <$>
- newtypeD (pure cx) newname [] KIND_ARG (mkSortableCon prefix con) commonDerivClause
+ newtypeD (pure cx) newname [] _k (mkSortableCon prefix con) commonDerivClause
where
newname = sortedTyName prefix tyName
mkSortableDataD _ x = error $ "Unhandled: mkSortableDataD " ++ show x
-#if MIN_VERSION_template_haskell(2,11,0)
bangDef = bang noSourceUnpackedness noSourceStrictness
-#else
-bangDef = pure NotStrict
-#endif
mkSortableCon prefix (RecC recName fields) =
recC (sortedTyName prefix recName) (map mkSortedField fields)
where
mkSortedField (varname, _, varty) =
-#if MIN_VERSION_template_haskell(2,11,0)
varBangType
(sortedValName varname)
(bangType bangDef [t|MkSortable $(pure varty)|])
-#else
- varStrictType
- (sortedValName varname)
- (strictType bangDef [t|MkSortable $(pure varty)|])
-#endif
mkSortableCon prefix (NormalC nm tys) =
normalC (sortedTyName prefix nm) (map mkSortedField tys)
where
mkSortedField (_, varty) =
-#if MIN_VERSION_template_haskell(2,11,0)
bangType bangDef [t|MkSortable $(pure varty)|]
-#else
- strictType bangDef [t|MkSortable $(pure varty)|]
-#endif
mkSortableCon _ x = error $ "Unhandled case in mkSortableCon: " ++ show x
sortedTyName pref = mkName . ("MkSort" ++) . (pref ++) . nameBase
@@ -150,8 +111,8 @@
firstToUpper (x:xs) = toUpper x : xs
firstToUpper [] = []
-mkSortableImpl pref (DataD _ _ _ KIND_ARG cons _) = map (mkSortableImplClause pref) cons
-mkSortableImpl pref (NewtypeD _ _ _ KIND_ARG con _) = [mkSortableImplClause pref con]
+mkSortableImpl pref (DataD _ _ _ _k cons _) = map (mkSortableImplClause pref) cons
+mkSortableImpl pref (NewtypeD _ _ _ _k con _) = [mkSortableImplClause pref con]
mkSortableImpl _ x = error $ "Unhandled: mkSortableImpl " ++ show x
mkSortableImplClause pref con = do