stylish-haskell 0.12.1.0 → 0.12.2.0

raw patch · 18 files changed

+653/−369 lines, 18 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +8/−0
• data/stylish-haskell.yaml +18/−6
• lib/Language/Haskell/Stylish/Config.hs +28/−11
• lib/Language/Haskell/Stylish/GHC.hs +21/−19
• lib/Language/Haskell/Stylish/Module.hs +15/−15
• lib/Language/Haskell/Stylish/Printer.hs +8/−0
• lib/Language/Haskell/Stylish/Step/Data.hs +58/−30
• lib/Language/Haskell/Stylish/Step/Imports.hs +11/−6
• lib/Language/Haskell/Stylish/Step/ModuleHeader.hs +31/−59
• lib/Language/Haskell/Stylish/Step/SimpleAlign.hs +83/−32
• lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs +10/−32
• stylish-haskell.cabal +1/−1
• tests/Language/Haskell/Stylish/Config/Tests.hs +25/−4
• tests/Language/Haskell/Stylish/Step/Data/Tests.hs +152/−75
• tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +8/−0
• tests/Language/Haskell/Stylish/Step/ModuleHeader/Tests.hs +12/−0
• tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs +105/−1
• tests/Language/Haskell/Stylish/Step/Squash/Tests.hs +59/−78

@@ -1,5 +1,13 @@ # CHANGELOG +- 0.12.2.0 (2020-10-08)+     *  align: Add a new option for aligning only adjacent items (by 1Computer1)+     *  align: Add support for aligning MultiWayIf syntax (by 1Computer1)+     *  data: Fix some issues with record field padding+     *  module_header: Add separate_lists option+     *  imports: Respect separate_lists for (..) imports+     *  data: Make sorting deriving list optional (by Maxim Koltsov)+ - 0.12.1.0 (2020-10-05)      *  Bump Cabal-version to 2.4 (by Łukasz Gołębiewski)      *  Fix "group" import sort with multi-line imports (by Maxim Koltsov)

@@ -27,6 +27,9 @@   #     # Should export lists be sorted?  Sorting is only performed within the   #     # export section, as delineated by Haddock comments.   #     sort: true+  #+  #     # See `separate_lists` for the `imports` step.+  #     separate_lists: true    # Format record definitions. This is disabled by default.   #@@ -58,10 +61,13 @@   #   #     # How many spaces to insert before "via" clause counted from indentation of deriving clause   #     # Possible values:-  #     # - "same_line" -- "{" and first field goes on the same line as the data constructor.-  #     # - "indent N" -- insert a new line and N spaces from the beginning of the data constructor+  #     # - "same_line" -- "via" part goes on the same line as "deriving" keyword.+  #     # - "indent N" -- insert a new line and N spaces from the beginning of "deriving" keyword.   #     via: "indent 2"   #+  #     # Sort typeclass names in the "deriving" list alphabetically.+  #     sort_deriving: true+  #   #     # Wheter or not to break enums onto several lines   #     #   #     # Default: false@@ -83,11 +89,17 @@    # Align the right hand side of some elements.  This is quite conservative   # and only applies to statements where each element occupies a single-  # line. All default to true.+  # line.+  # Possible values:+  # - always - Always align statements.+  # - adjacent - Align statements that are on adjacent lines in groups.+  # - never - Never align statements.+  # All default to always.   - simple_align:-      cases: true-      top_level_patterns: true-      records: true+      cases: always+      top_level_patterns: always+      records: always+      multi_way_if: always    # Import cleanup   - imports:

@@ -1,5 +1,5 @@ ---------------------------------------------------------------------------------{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE BlockArguments    #-} {-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell   #-}@@ -10,10 +10,12 @@     , defaultConfigBytes     , configFilePath     , loadConfig+    , parseConfig     ) where   --------------------------------------------------------------------------------+import           Control.Applicative                              ((<|>)) import           Control.Monad                                    (forM, mzero) import           Data.Aeson                                       (FromJSON (..)) import qualified Data.Aeson                                       as A@@ -43,8 +45,8 @@ import           Language.Haskell.Stylish.Step import qualified Language.Haskell.Stylish.Step.Data               as Data import qualified Language.Haskell.Stylish.Step.Imports            as Imports-import qualified Language.Haskell.Stylish.Step.ModuleHeader       as ModuleHeader import qualified Language.Haskell.Stylish.Step.LanguagePragmas    as LanguagePragmas+import qualified Language.Haskell.Stylish.Step.ModuleHeader       as ModuleHeader import qualified Language.Haskell.Stylish.Step.SimpleAlign        as SimpleAlign import qualified Language.Haskell.Stylish.Step.Squash             as Squash import qualified Language.Haskell.Stylish.Step.Tabs               as Tabs@@ -74,7 +76,7 @@   deriving (Eq)  instance Show ExitCodeBehavior where-  show NormalExitBehavior = "normal"+  show NormalExitBehavior        = "normal"   show ErrorOnFormatExitBehavior = "error_on_format"  --------------------------------------------------------------------------------@@ -195,20 +197,34 @@ -------------------------------------------------------------------------------- parseModuleHeader :: Config -> A.Object -> A.Parser Step parseModuleHeader _ o = fmap ModuleHeader.step $ ModuleHeader.Config-    <$> o A..:? "indent" A..!= (ModuleHeader.indent ModuleHeader.defaultConfig)-    <*> o A..:? "sort"   A..!= (ModuleHeader.sort ModuleHeader.defaultConfig)+    <$> o A..:? "indent"         A..!= ModuleHeader.indent        def+    <*> o A..:? "sort"           A..!= ModuleHeader.sort          def+    <*> o A..:? "separate_lists" A..!= ModuleHeader.separateLists def+  where+    def = ModuleHeader.defaultConfig  -------------------------------------------------------------------------------- parseSimpleAlign :: Config -> A.Object -> A.Parser Step parseSimpleAlign c o = SimpleAlign.step     <$> pure (configColumns c)     <*> (SimpleAlign.Config-        <$> withDef SimpleAlign.cCases            "cases"-        <*> withDef SimpleAlign.cTopLevelPatterns "top_level_patterns"-        <*> withDef SimpleAlign.cRecords          "records")+        <$> parseAlign "cases"              SimpleAlign.cCases+        <*> parseAlign "top_level_patterns" SimpleAlign.cTopLevelPatterns+        <*> parseAlign "records"            SimpleAlign.cRecords+        <*> parseAlign "multi_way_if"       SimpleAlign.cMultiWayIf)   where-    withDef f k = fromMaybe (f SimpleAlign.defaultConfig) <$> (o A..:? k)+    parseAlign key f =+        (o A..:? key >>= parseEnum aligns (f SimpleAlign.defaultConfig)) <|>+        (boolToAlign <$> o A..: key)+    aligns =+        [ ("always",   SimpleAlign.Always)+        , ("adjacent", SimpleAlign.Adjacent)+        , ("never",    SimpleAlign.Never)+        ]+    boolToAlign True  = SimpleAlign.Always+    boolToAlign False = SimpleAlign.Never + -------------------------------------------------------------------------------- parseRecords :: Config -> A.Object -> A.Parser Step parseRecords c o = Data.step@@ -221,6 +237,7 @@         <*> (o A..:? "break_single_constructors" A..!= True)         <*> (o A..: "via" >>= parseIndent)         <*> (o A..:? "curried_context" A..!= False)+        <*> (o A..:? "sort_deriving" A..!= True)         <*> pure configMaxColumns)   where     configMaxColumns =@@ -290,8 +307,8 @@      parseListPadding = \case         A.String "module_name" -> pure Imports.LPModuleName-        A.Number n | n >= 1 -> pure $ Imports.LPConstant (truncate n)-        v -> A.typeMismatch "'module_name' or >=1 number" v+        A.Number n | n >= 1    -> pure $ Imports.LPConstant (truncate n)+        v                      -> A.typeMismatch "'module_name' or >=1 number" v  -------------------------------------------------------------------------------- parseLanguagePragmas :: Config -> A.Object -> A.Parser Step

@@ -6,6 +6,7 @@   , dropBeforeLocated   , dropBeforeAndAfter     -- * Unsafe getters+  , unsafeGetRealSrcSpan   , getEndLineUnsafe   , getStartLineUnsafe     -- * Standard settings@@ -18,32 +19,33 @@   ) where  ---------------------------------------------------------------------------------import           Data.Function (on)+import           Data.Function     (on)  ---------------------------------------------------------------------------------import           DynFlags                        (Settings(..), defaultDynFlags)-import qualified DynFlags                        as GHC-import           FileSettings                    (FileSettings(..))-import           GHC.Fingerprint                 (fingerprint0)+import           DynFlags          (Settings (..), defaultDynFlags)+import qualified DynFlags          as GHC+import           FileSettings      (FileSettings (..))+import           GHC.Fingerprint   (fingerprint0) import           GHC.Platform-import           GHC.Version                     (cProjectVersion)-import           GhcNameVersion                  (GhcNameVersion(..))-import           PlatformConstants               (PlatformConstants(..))-import           SrcLoc                          (GenLocated(..), SrcSpan(..))-import           SrcLoc                          (Located, RealLocated)-import           SrcLoc                          (srcSpanStartLine, srcSpanEndLine)-import           ToolSettings                    (ToolSettings(..))-import qualified Outputable                      as GHC+import           GHC.Version       (cProjectVersion)+import           GhcNameVersion    (GhcNameVersion (..))+import qualified Outputable        as GHC+import           PlatformConstants (PlatformConstants (..))+import           SrcLoc            (GenLocated (..), Located, RealLocated,+                                    RealSrcSpan, SrcSpan (..), srcSpanEndLine,+                                    srcSpanStartLine)+import           ToolSettings      (ToolSettings (..)) +unsafeGetRealSrcSpan :: Located a -> RealSrcSpan+unsafeGetRealSrcSpan = \case+  (L (RealSrcSpan s) _) -> s+  _                     -> error "could not get source code location"+ getStartLineUnsafe :: Located a -> Int-getStartLineUnsafe = \case-  (L (RealSrcSpan s) _) -> srcSpanStartLine s-  _ -> error "could not get start line of block"+getStartLineUnsafe = srcSpanStartLine . unsafeGetRealSrcSpan  getEndLineUnsafe :: Located a -> Int-getEndLineUnsafe = \case-  (L (RealSrcSpan s) _) -> srcSpanEndLine s-  _ -> error "could not get end line of block"+getEndLineUnsafe = srcSpanEndLine . unsafeGetRealSrcSpan  dropAfterLocated :: Maybe (Located a) -> [RealLocated b] -> [RealLocated b] dropAfterLocated loc xs = case loc of

@@ -24,6 +24,7 @@   , moduleComments   , moduleLanguagePragmas   , queryModule+  , groupByLine      -- * Imports   , canMergeImport@@ -192,22 +193,21 @@  -- | Get groups of imports from module moduleImportGroups :: Module -> [NonEmpty (Located Import)]-moduleImportGroups = go [] Nothing . moduleImports+moduleImportGroups = groupByLine unsafeGetRealSrcSpan . moduleImports++-- The same logic as 'Language.Haskell.Stylish.Module.moduleImportGroups'.+groupByLine :: (a -> RealSrcSpan) -> [a] -> [NonEmpty a]+groupByLine f = go [] Nothing   where-    -- Run through all imports (assume they are sorted already in order of-    -- appearance in the file) and group the ones that are on consecutive-    -- lines.-    go  :: [Located Import] -> Maybe Int -> [Located Import]-        -> [NonEmpty (Located Import)]-    go acc _        []                   = ne acc-    go acc mbCurrentLine (imp : impRest) =-        let-          lStart = getStartLineUnsafe imp-          lEnd = getEndLineUnsafe imp in-        case mbCurrentLine of-            Just lPrevEnd | lPrevEnd + 1 < lStart-              -> ne acc ++ go [imp] (Just lEnd) impRest-            _ -> go (acc ++ [imp]) (Just lEnd) impRest+    go acc _ [] = ne acc+    go acc mbCurrentLine (x:xs) =+      let+        lStart = GHC.srcSpanStartLine (f x)+        lEnd = GHC.srcSpanEndLine (f x) in+      case mbCurrentLine of+        Just lPrevEnd | lPrevEnd + 1 < lStart+          -> ne acc ++ go [x] (Just lEnd) xs+        _ -> go (acc ++ [x]) (Just lEnd) xs      ne []       = []     ne (x : xs) = [x :| xs]

@@ -44,6 +44,7 @@   , space   , spaces   , suffix+  , pad      -- ** Advanced combinators   , withColumns@@ -322,6 +323,13 @@ -- | Suffix a printer with another one suffix :: P a -> P b -> P a suffix pa pb = pb >> pa++-- | Indent to a given number of spaces.  If the current line already exceeds+-- that number in length, nothing happens.+pad :: Int -> P ()+pad n = do+    len <- length <$> getCurrentLine+    spaces $ n - len  -- | Gets comment on supplied 'line' and removes it from the state removeLineComment :: Int -> P (Maybe AnnotationComment)

@@ -1,10 +1,12 @@-{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE BlockArguments  #-} {-# LANGUAGE DoAndIfThenElse #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE NamedFieldPuns  #-} {-# LANGUAGE RecordWildCards #-} module Language.Haskell.Stylish.Step.Data   ( Config(..)+  , defaultConfig+   , Indent(..)   , MaxColumns(..)   , step@@ -22,19 +24,24 @@  -------------------------------------------------------------------------------- import           ApiAnnotation                    (AnnotationComment)-import           BasicTypes                       (LexicalFixity(..))-import           GHC.Hs.Decls                     (HsDecl(..), HsDataDefn(..))-import           GHC.Hs.Decls                     (TyClDecl(..), NewOrData(..))-import           GHC.Hs.Decls                     (HsDerivingClause(..), DerivStrategy(..))-import           GHC.Hs.Decls                     (ConDecl(..))-import           GHC.Hs.Extension                 (GhcPs, NoExtField(..), noExtCon)-import           GHC.Hs.Types                     (ConDeclField(..), HsContext)-import           GHC.Hs.Types                     (HsType(..), ForallVisFlag(..))-import           GHC.Hs.Types                     (LHsQTyVars(..), HsTyVarBndr(..))-import           GHC.Hs.Types                     (HsConDetails(..), HsImplicitBndrs(..))+import           BasicTypes                       (LexicalFixity (..))+import           GHC.Hs.Decls                     (ConDecl (..),+                                                   DerivStrategy (..),+                                                   HsDataDefn (..), HsDecl (..),+                                                   HsDerivingClause (..),+                                                   NewOrData (..),+                                                   TyClDecl (..))+import           GHC.Hs.Extension                 (GhcPs, NoExtField (..),+                                                   noExtCon)+import           GHC.Hs.Types                     (ConDeclField (..),+                                                   ForallVisFlag (..),+                                                   HsConDetails (..), HsContext,+                                                   HsImplicitBndrs (..),+                                                   HsTyVarBndr (..),+                                                   HsType (..), LHsQTyVars (..)) import           RdrName                          (RdrName)-import           SrcLoc                           (Located, RealLocated)-import           SrcLoc                           (GenLocated(..))+import           SrcLoc                           (GenLocated (..), Located,+                                                   RealLocated)  -------------------------------------------------------------------------------- import           Language.Haskell.Stylish.Block@@ -71,9 +78,26 @@       -- ^ Indentation between @via@ clause and start of deriving column start     , cCurriedContext          :: !Bool       -- ^ If true, use curried context. E.g: @allValues :: Enum a => Bounded a => Proxy a -> [a]@+    , cSortDeriving            :: !Bool+      -- ^ If true, will sort type classes in a @deriving@ list.     , cMaxColumns              :: !MaxColumns     } deriving (Show) +-- | TODO: pass in MaxColumns?+defaultConfig :: Config+defaultConfig = Config+    { cEquals          = Indent 4+    , cFirstField      = Indent 4+    , cFieldComment    = 2+    , cDeriving        = 4+    , cBreakEnums      = True+    , cBreakSingleConstructors = False+    , cVia             = Indent 4+    , cSortDeriving    = True+    , cMaxColumns      = NoMaxColumns+    , cCurriedContext    = False+    }+ step :: Config -> Step step cfg = makeStep "Data" \ls m -> applyChanges (changes m) ls   where@@ -188,8 +212,8 @@ data DataDecl = MkDataDecl   { dataDeclName :: Located RdrName   , dataTypeVars :: LHsQTyVars GhcPs-  , dataDefn :: HsDataDefn GhcPs-  , dataFixity :: LexicalFixity+  , dataDefn     :: HsDataDefn GhcPs+  , dataFixity   :: LexicalFixity   }  putDeriving :: Config -> Located (HsDerivingClause GhcPs) -> P ()@@ -197,10 +221,10 @@   putText "deriving"    forM_ (deriv_clause_strategy clause) \case-    L _ StockStrategy -> space >> putText "stock"+    L _ StockStrategy    -> space >> putText "stock"     L _ AnyclassStrategy -> space >> putText "anyclass"-    L _ NewtypeStrategy -> space >> putText "newtype"-    L _ (ViaStrategy _) -> pure ()+    L _ NewtypeStrategy  -> space >> putText "newtype"+    L _ (ViaStrategy _)  -> pure ()    putCond     withinColumns@@ -222,13 +246,13 @@    where     getType = \case-      HsIB _ tp -> tp+      HsIB _ tp          -> tp       XHsImplicitBndrs x -> noExtCon x      withinColumns PrinterState{currentLine} =       case cMaxColumns of         MaxColumns maxCols -> length currentLine <= maxCols-        NoMaxColumns -> True+        NoMaxColumns       -> True      oneLinePrint = do       space@@ -266,7 +290,7 @@       = clause       & deriv_clause_tys       & unLocated-      & sortBy compareOutputable+      & (if cSortDeriving then sortBy compareOutputable else id)       & fmap hsib_body      headTy =@@ -359,8 +383,10 @@         sep space (fmap putOutputable xs)       RecCon (L recPos (L posFirst firstArg : args)) -> do         putRdrName con_name-        skipToBrace >> putText "{"+        skipToBrace         bracePos <- getCurrentLineLength+        putText "{"+        let fieldPos = bracePos + 2         space          -- Unless everything's configured to be on the same line, put pending@@ -369,7 +395,7 @@           removeCommentTo posFirst >>= mapM_ \c -> putComment c >> sepDecl bracePos          -- Put first decl field-        putConDeclField cfg firstArg+        pad fieldPos >> putConDeclField cfg firstArg         unless (cFirstField cfg == SameLine) (putEolComment posFirst)          -- Put tail decl fields@@ -393,6 +419,7 @@         skipToBrace >> putText "}"      where+      -- Jump to the first brace of the first record of the first constructor.       skipToBrace = case (cEquals cfg, cFirstField cfg) of         (_, Indent y) | not (cBreakSingleConstructors cfg) -> newline >> spaces y         (SameLine, SameLine) -> space@@ -400,12 +427,13 @@         (SameLine, Indent y) -> newline >> spaces (consIndent + y)         (Indent _, SameLine) -> space +      -- Jump to the next declaration.       sepDecl bracePos = newline >> spaces case (cEquals cfg, cFirstField cfg) of         (_, Indent y) | not (cBreakSingleConstructors cfg) -> y-        (SameLine, SameLine) -> bracePos - 1 -- back one from brace pos to place comma+        (SameLine, SameLine) -> bracePos         (Indent x, Indent y) -> x + y + 2-        (SameLine, Indent y) -> bracePos - 1 + y - 2-        (Indent x, SameLine) -> bracePos - 1 + x - 2+        (SameLine, Indent y) -> bracePos + y - 2+        (Indent x, SameLine) -> bracePos + x - 2  putNewtypeConstructor :: Config -> Located (ConDecl GhcPs) -> P () putNewtypeConstructor cfg (L _ cons) = case cons of@@ -491,7 +519,7 @@   where     isGADTCons = \case       L _ (ConDeclGADT {}) -> True-      _ -> False+      _                    -> False  isNewtype :: DataDecl -> Bool isNewtype = (== NewType) . dd_ND . dataDefn@@ -505,7 +533,7 @@     isUnary = \case       L _ (ConDeclH98 {..}) -> case con_args of         PrefixCon [] -> True-        _ -> False+        _            -> False       _ -> False  hasConstructors :: DataDecl -> Bool

@@ -11,6 +11,8 @@   , EmptyListAlign (..)   , ListPadding (..)   , step++  , printImport   ) where  --------------------------------------------------------------------------------@@ -213,7 +215,7 @@         _ -> space >> putText "()"     Just (L _ imports) -> do       let printedImports = flagEnds $ -- [P ()]-            fmap ((printImport Options{..}) . unLocated)+            fmap ((printImport separateLists) . unLocated)             (prepareImportList imports)        -- Since we might need to output the import module name several times, we@@ -308,18 +310,20 @@   ---------------------------------------------------------------------------------printImport :: Options -> IE GhcPs -> P ()-printImport Options{..} (IEVar _ name) = do+printImport :: Bool -> IE GhcPs -> P ()+printImport _ (IEVar _ name) = do     printIeWrappedName name printImport _ (IEThingAbs _ name) = do     printIeWrappedName name-printImport _ (IEThingAll _ name) = do+printImport separateLists (IEThingAll _ name) = do     printIeWrappedName name-    space+    when separateLists space     putText "(..)" printImport _ (IEModuleContents _ (L _ m)) = do+    putText "module"+    space     putText (moduleNameString m)-printImport Options{..} (IEThingWith _ name _wildcard imps _) = do+printImport separateLists (IEThingWith _ name _wildcard imps _) = do     printIeWrappedName name     when separateLists space     parenthesize $@@ -332,6 +336,7 @@     error "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDocNamed'" printImport _ (XIE ext) =     GHC.noExtCon ext+  -------------------------------------------------------------------------------- printIeWrappedName :: LIEWrappedName RdrName -> P ()

@@ -7,27 +7,26 @@   ) where  ---------------------------------------------------------------------------------import           ApiAnnotation                    (AnnKeywordId (..),-                                                   AnnotationComment (..))-import           Control.Monad                    (forM_, join, when)-import           Data.Bifunctor                   (second)-import           Data.Foldable                    (find, toList)-import           Data.Function                    (on, (&))-import qualified Data.List                        as L-import           Data.List.NonEmpty               (NonEmpty (..))-import qualified Data.List.NonEmpty               as NonEmpty-import           Data.Maybe                       (isJust, listToMaybe)-import qualified GHC.Hs.Doc                       as GHC-import           GHC.Hs.Extension                 (GhcPs)-import qualified GHC.Hs.Extension                 as GHC-import           GHC.Hs.ImpExp                    (IE (..))-import qualified GHC.Hs.ImpExp                    as GHC-import qualified Module                           as GHC-import           SrcLoc                           (GenLocated (..), Located,-                                                   RealLocated, SrcSpan (..),-                                                   srcSpanEndLine,-                                                   srcSpanStartLine, unLoc)-import           Util                             (notNull)+import           ApiAnnotation                         (AnnKeywordId (..),+                                                        AnnotationComment (..))+import           Control.Monad                         (forM_, join, when)+import           Data.Bifunctor                        (second)+import           Data.Foldable                         (find, toList)+import           Data.Function                         ((&))+import qualified Data.List                             as L+import           Data.List.NonEmpty                    (NonEmpty (..))+import qualified Data.List.NonEmpty                    as NonEmpty+import           Data.Maybe                            (isJust, listToMaybe)+import qualified GHC.Hs.Doc                            as GHC+import           GHC.Hs.Extension                      (GhcPs)+import qualified GHC.Hs.ImpExp                         as GHC+import qualified Module                                as GHC+import           SrcLoc                                (GenLocated (..),+                                                        Located, RealLocated,+                                                        SrcSpan (..),+                                                        srcSpanEndLine,+                                                        srcSpanStartLine, unLoc)+import           Util                                  (notNull)  -------------------------------------------------------------------------------- import           Language.Haskell.Stylish.Block@@ -37,19 +36,20 @@ import           Language.Haskell.Stylish.Ordering import           Language.Haskell.Stylish.Printer import           Language.Haskell.Stylish.Step+import qualified Language.Haskell.Stylish.Step.Imports as Imports   data Config = Config-    -- TODO(jaspervdj): Use the same sorting as in `Imports`?-    -- TODO: make sorting optional?-    { indent :: Int-    , sort   :: Bool+    { indent        :: Int+    , sort          :: Bool+    , separateLists :: Bool     }  defaultConfig :: Config defaultConfig = Config-    { indent = 4-    , sort   = True+    { indent        = 4+    , sort          = True+    , separateLists = True     }  step :: Config -> Step@@ -182,9 +182,7 @@     -- > xxxxyyfoo     -- > xxxx) where     doIndent = spaces (indent conf)-    doHang = do-        len <- length <$> getCurrentLine-        spaces $ indent conf + 2 - len+    doHang = pad (indent conf + 2)      doSort = if sort conf then NonEmpty.sortBy compareLIE else id @@ -218,33 +216,7 @@     printExportsGroupTail (x : xs) = printExportsTail [([], x :| xs)]     printExportsGroupTail []       = pure () +    -- NOTE(jaspervdj): This code is almost the same as the import printing+    -- in 'Imports' and should be merged.     printExport :: GHC.LIE GhcPs -> P ()-    printExport (L _ export) = case export of-      IEVar _ name -> putOutputable name-      IEThingAbs _ name -> putOutputable name-      IEThingAll _ name -> do-        putOutputable name-        space-        putText "(..)"-      IEModuleContents _ (L _ m) -> do-        putText "module"-        space-        putText (showOutputable m)-      IEThingWith _ name _wildcard imps _ -> do-        putOutputable name-        space-        putText "("-        sep (comma >> space) $-          fmap putOutputable $ L.sortBy (compareWrappedName `on` unLoc) imps-        putText ")"-      IEGroup _ _ _ ->-        error $-          "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEGroup'" <> showOutputable export-      IEDoc _ _ ->-        error $-          "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDoc'" <> showOutputable export-      IEDocNamed _ _ ->-        error $-          "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDocNamed'" <> showOutputable export-      XIE ext ->-        GHC.noExtCon ext+    printExport = Imports.printImport (separateLists conf) . unLoc

@@ -1,15 +1,18 @@ ---------------------------------------------------------------------------------{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies    #-} module Language.Haskell.Stylish.Step.SimpleAlign     ( Config (..)+    , Align (..)     , defaultConfig     , step     ) where   ---------------------------------------------------------------------------------import           Control.Monad                   (guard)-import           Data.List                       (foldl')+import           Data.Either                     (partitionEithers)+import           Data.Foldable                   (toList)+import           Data.List                       (foldl', foldl1', sortOn) import           Data.Maybe                      (fromMaybe) import qualified GHC.Hs                          as Hs import qualified SrcLoc                          as S@@ -25,21 +28,35 @@  -------------------------------------------------------------------------------- data Config = Config-    { cCases            :: !Bool-    , cTopLevelPatterns :: !Bool-    , cRecords          :: !Bool+    { cCases            :: Align+    , cTopLevelPatterns :: Align+    , cRecords          :: Align+    , cMultiWayIf       :: Align     } deriving (Show) +data Align+    = Always+    | Adjacent+    | Never+    deriving (Eq, Show) --------------------------------------------------------------------------------- defaultConfig :: Config defaultConfig = Config-    { cCases            = True-    , cTopLevelPatterns = True-    , cRecords          = True+    { cCases            = Always+    , cTopLevelPatterns = Always+    , cRecords          = Always+    , cMultiWayIf       = Always     } +groupAlign :: Align -> [Alignable S.RealSrcSpan] -> [[Alignable S.RealSrcSpan]]+groupAlign a xs = case a of+    Never    -> []+    Adjacent -> byLine . sortOn (S.srcSpanStartLine . aLeft) $ xs+    Always   -> [xs]+  where+    byLine = map toList . groupByLine aLeft + -------------------------------------------------------------------------------- type Record = [S.Located (Hs.ConDeclField Hs.GhcPs)] @@ -62,8 +79,8 @@   ---------------------------------------------------------------------------------recordToAlignable :: Record -> [Alignable S.RealSrcSpan]-recordToAlignable = fromMaybe [] . traverse fieldDeclToAlignable+recordToAlignable :: Config -> Record -> [[Alignable S.RealSrcSpan]]+recordToAlignable conf = groupAlign (cRecords conf) . fromMaybe [] . traverse fieldDeclToAlignable   --------------------------------------------------------------------------------@@ -86,36 +103,36 @@ matchGroupToAlignable     :: Config     -> Hs.MatchGroup Hs.GhcPs (Hs.LHsExpr Hs.GhcPs)-    -> [Alignable S.RealSrcSpan]+    -> [[Alignable S.RealSrcSpan]] matchGroupToAlignable _conf (Hs.XMatchGroup x) = Hs.noExtCon x-matchGroupToAlignable conf (Hs.MG _ alts _) =-  fromMaybe [] $ traverse (matchToAlignable conf) (S.unLoc alts)+matchGroupToAlignable conf (Hs.MG _ alts _) = cases' ++ patterns'+  where+    (cases, patterns) = partitionEithers . fromMaybe [] $ traverse matchToAlignable (S.unLoc alts)+    cases' = groupAlign (cCases conf) cases+    patterns' = groupAlign (cTopLevelPatterns conf) patterns   -------------------------------------------------------------------------------- matchToAlignable-    :: Config-    -> S.Located (Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))-    -> Maybe (Alignable S.RealSrcSpan)-matchToAlignable conf (S.L matchLoc m@(Hs.Match _ Hs.CaseAlt pats@(_ : _) grhss)) = do+    :: S.Located (Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))+    -> Maybe (Either (Alignable S.RealSrcSpan) (Alignable S.RealSrcSpan))+matchToAlignable (S.L matchLoc m@(Hs.Match _ Hs.CaseAlt pats@(_ : _) grhss)) = do   let patsLocs   = map S.getLoc pats       pat        = last patsLocs       guards     = getGuards m       guardsLocs = map S.getLoc guards       left       = foldl' S.combineSrcSpans pat guardsLocs-  guard $ cCases conf   body     <- rhsBody grhss   matchPos <- toRealSrcSpan matchLoc   leftPos  <- toRealSrcSpan left   rightPos <- toRealSrcSpan $ S.getLoc body-  Just $ Alignable+  Just . Left $ Alignable     { aContainer = matchPos     , aLeft      = leftPos     , aRight     = rightPos     , aRightLead = length "-> "     }-matchToAlignable conf (S.L matchLoc (Hs.Match _ (Hs.FunRhs name _ _) pats@(_ : _) grhss)) = do-  guard $ cTopLevelPatterns conf+matchToAlignable (S.L matchLoc (Hs.Match _ (Hs.FunRhs name _ _) pats@(_ : _) grhss)) = do   body <- unguardedRhsBody grhss   let patsLocs = map S.getLoc pats       nameLoc  = S.getLoc name@@ -124,28 +141,62 @@   matchPos <- toRealSrcSpan matchLoc   leftPos  <- toRealSrcSpan left   bodyPos  <- toRealSrcSpan bodyLoc-  Just $ Alignable+  Just . Right $ Alignable     { aContainer = matchPos     , aLeft      = leftPos     , aRight     = bodyPos     , aRightLead = length "= "     }-matchToAlignable _conf (S.L _ (Hs.XMatch x))       = Hs.noExtCon x-matchToAlignable _conf (S.L _ (Hs.Match _ _ _ _))  = Nothing+matchToAlignable (S.L _ (Hs.XMatch x))      = Hs.noExtCon x+matchToAlignable (S.L _ (Hs.Match _ _ _ _)) = Nothing   --------------------------------------------------------------------------------+multiWayIfToAlignable+    :: Config+    -> Hs.LHsExpr Hs.GhcPs+    -> [[Alignable S.RealSrcSpan]]+multiWayIfToAlignable conf (S.L _ (Hs.HsMultiIf _ grhss)) =+    groupAlign (cMultiWayIf conf) as+  where+    as = fromMaybe [] $ traverse grhsToAlignable grhss+multiWayIfToAlignable _conf _ = []+++--------------------------------------------------------------------------------+grhsToAlignable+    :: S.Located (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))+    -> Maybe (Alignable S.RealSrcSpan)+grhsToAlignable (S.L grhsloc (Hs.GRHS _ guards@(_ : _) body)) = do+    let guardsLocs = map S.getLoc guards+        bodyLoc    = S.getLoc body+        left       = foldl1' S.combineSrcSpans guardsLocs+    matchPos <- toRealSrcSpan grhsloc+    leftPos  <- toRealSrcSpan left+    bodyPos  <- toRealSrcSpan bodyLoc+    Just $ Alignable+        { aContainer = matchPos+        , aLeft      = leftPos+        , aRight     = bodyPos+        , aRightLead = length "-> "+        }+grhsToAlignable (S.L _ (Hs.XGRHS x)) = Hs.noExtCon x+grhsToAlignable (S.L _ _)            = Nothing+++-------------------------------------------------------------------------------- step :: Maybe Int -> Config -> Step-step maxColumns config = makeStep "Cases" $ \ls module' ->+step maxColumns config@(Config {..}) = makeStep "Cases" $ \ls module' ->     let changes             :: (S.Located (Hs.HsModule Hs.GhcPs) -> [a])-            -> (a -> [Alignable S.RealSrcSpan])+            -> (a -> [[Alignable S.RealSrcSpan]])             -> [Change String]-        changes search toAlign = concat $-            map (align maxColumns) . map toAlign $ search (parsedModule module')+        changes search toAlign =+            (concatMap . concatMap) (align maxColumns) . map toAlign $ search (parsedModule module')          configured :: [Change String]         configured = concat $-            [changes records recordToAlignable | cRecords config] ++-            [changes everything (matchGroupToAlignable config)] in+            [changes records (recordToAlignable config)] +++            [changes everything (matchGroupToAlignable config)] +++            [changes everything (multiWayIfToAlignable config)] in     applyChanges configured ls

@@ -52,38 +52,18 @@ groupPerLine = M.toList . M.fromListWith (++) .     map (\((r, c), x) -> (r, [(c, x)])) -----------------------------------------------------------------------------------typeSigs :: Module -> Lines -> [((Int, Int), String)]-typeSigs module' ls =-    [ (pos, "::")+-- | Find symbol positions in the module.  Currently only searches in type+-- signatures.+findSymbol :: Module -> Lines -> String -> [((Int, Int), String)]+findSymbol module' ls sym =+    [ (pos, sym)     | TypeSig _ funLoc typeLoc <- everything (rawModuleDecls $ moduleDecls module') :: [Sig GhcPs]-    , (_, funEnd)              <- infoPoints funLoc-    , (typeStart, _)           <- infoPoints [hsSigWcType typeLoc]-    , pos                      <- maybeToList $ between funEnd typeStart "::" ls+    , (funStart, _)            <- infoPoints funLoc+    , (_, typeEnd)             <- infoPoints [hsSigWcType typeLoc]+    , pos                      <- maybeToList $ between funStart typeEnd sym ls     ]  ---------------------------------------------------------------------------------contexts :: Module -> Lines -> [((Int, Int), String)]-contexts module' ls =-    [ (pos, "=>")-    | TypeSig _ _ typeLoc <- everything (rawModuleDecls $ moduleDecls module') :: [Sig GhcPs]-    , (start, end)        <- infoPoints [hsSigWcType typeLoc]-    , pos                 <- maybeToList $ between start end "=>" ls-    ]------------------------------------------------------------------------------------typeFuns :: Module -> Lines -> [((Int, Int), String)]-typeFuns module' ls =-    [ (pos, "->")-    | TypeSig _ _ typeLoc <- everything (rawModuleDecls $ moduleDecls module') :: [Sig GhcPs]-    , (start, end)        <- infoPoints [hsSigWcType typeLoc]-    , pos                 <- maybeToList $ between start end "->" ls-    ]----------------------------------------------------------------------------------- -- | Search for a needle in a haystack of lines. Only part the inside (startRow, -- startCol), (endRow, endCol) is searched. The return value is the position of -- the needle.@@ -113,7 +93,5 @@   where     changes = (if alp then addLanguagePragma lg "UnicodeSyntax" module' else []) ++         replaceAll perLine-    perLine = sort $ groupPerLine $-        typeSigs module' ls ++-        contexts module' ls ++-        typeFuns module' ls+    toReplace = [ "::", "=>", "->" ]+    perLine = sort $ groupPerLine $ concatMap (findSymbol module' ls) toReplace

@@ -1,6 +1,6 @@ Cabal-version: 2.4 Name:          stylish-haskell-Version:       0.12.1.0+Version:       0.12.2.0 Synopsis:      Haskell code prettifier Homepage:      https://github.com/jaspervdj/stylish-haskell License:       BSD-3-Clause

@@ -4,11 +4,14 @@   ---------------------------------------------------------------------------------import qualified Data.Set                        as Set+import qualified Data.Aeson.Types                    as Aeson+import qualified Data.ByteString.Lazy.Char8          as BL8+import qualified Data.Set                            as Set+import qualified Data.YAML.Aeson                     as Yaml import           System.Directory-import           Test.Framework                  (Test, testGroup)-import           Test.Framework.Providers.HUnit  (testCase)-import           Test.HUnit                      (Assertion, assert)+import           Test.Framework                      (Test, testGroup)+import           Test.Framework.Providers.HUnit      (testCase)+import           Test.HUnit                          (Assertion, assert, (@?=))   --------------------------------------------------------------------------------@@ -31,6 +34,8 @@                testSpecifiedColumns     , testCase "Correctly read .stylish-haskell.yaml file with no max column number"                testNoColumns+    , testCase "Backwards-compatible align options"+               testBoolSimpleAlign     ]  @@ -103,6 +108,22 @@     createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish3)]     where       expected = Nothing+++--------------------------------------------------------------------------------+testBoolSimpleAlign :: Assertion+testBoolSimpleAlign = do+    Right val <- pure $ Yaml.decode1 $ BL8.pack config+    Aeson.Success conf <- pure $ Aeson.parse parseConfig val+    length (configSteps conf) @?= 1+  where+    config = unlines+      [ "steps:"+      , "  - simple_align:"+      , "      cases: true"+      , "      top_level_patterns: always"+      , "      records: false"+      ]   -- | Example cabal file borrowed from

@@ -1,9 +1,11 @@+{-# LANGUAGE OverloadedLists   #-}+{-# LANGUAGE OverloadedStrings #-} module Language.Haskell.Stylish.Step.Data.Tests     ( tests     ) where  import           Language.Haskell.Stylish.Step.Data-import           Language.Haskell.Stylish.Tests.Util (testStep)+import           Language.Haskell.Stylish.Tests.Util (assertSnippet, testStep) import           Test.Framework                      (Test, testGroup) import           Test.Framework.Providers.HUnit      (testCase) import           Test.HUnit                          (Assertion, (@=?))@@ -65,6 +67,9 @@     , testCase "case 52" case52     , testCase "case 53" case53     , testCase "case 54" case54+    , testCase "case 55" case55+    , testCase "case 56" case56+    , testCase "case 57" case57     ]  case00 :: Assertion@@ -455,79 +460,67 @@        ]  case21 :: Assertion-case21 = expected @=? testStep (step sameSameStyle) input-  where-    input = unlines-       [ "data Foo a"-       , "  = Foo { a :: Int,"-       , "          a2 :: String"-       , "          -- ^ some haddock"-       , "        }"-       , "  | Bar { b :: a }  deriving (Eq, Show)"-       , "  deriving (ToJSON)"-       ]--    expected = unlines-       [ "data Foo a = Foo { a :: Int"-       , "                 , a2 :: String"-       , "                   -- ^ some haddock"-       , "                 }"-       , "           | Bar { b :: a"-       , "                 }"-       , "  deriving (Eq, Show)"-       , "  deriving (ToJSON)"-       ]+case21 = assertSnippet (step sameSameStyle)+   [ "data Foo a"+   , "  = Foo { a :: Int,"+   , "          a2 :: String"+   , "          -- ^ some haddock"+   , "        }"+   , "  | Bar { b :: a }  deriving (Eq, Show)"+   , "  deriving (ToJSON)"+   ]+   [ "data Foo a = Foo { a :: Int"+   , "                 , a2 :: String"+   , "                   -- ^ some haddock"+   , "                 }"+   , "           | Bar { b :: a"+   , "                 }"+   , "  deriving (Eq, Show)"+   , "  deriving (ToJSON)"+   ]  case22 :: Assertion-case22 = expected @=? testStep (step sameIndentStyle) input-  where-    input = unlines-       [ "data Foo a"-       , "  = Foo { a :: Int,"-       , "          a2 :: String"-       , "          -- ^ some haddock"-       , "        }"-       , "  | Bar { b :: a }  deriving (Eq, Show)"-       , "  deriving (ToJSON)"-       ]--    expected = unlines-       [ "data Foo a = Foo"-       , "               { a :: Int"-       , "               , a2 :: String"-       , "                 -- ^ some haddock"-       , "               }"-       , "           | Bar"-       , "               { b :: a"-       , "               }"-       , "  deriving (Eq, Show)"-       , "  deriving (ToJSON)"-       ]+case22 = assertSnippet (step sameIndentStyle)+   [ "data Foo a"+   , "  = Foo { a :: Int,"+   , "          a2 :: String"+   , "          -- ^ some haddock"+   , "        }"+   , "  | Bar { b :: a }  deriving (Eq, Show)"+   , "  deriving (ToJSON)"+   ]+   [ "data Foo a = Foo"+   , "               { a :: Int"+   , "               , a2 :: String"+   , "                 -- ^ some haddock"+   , "               }"+   , "           | Bar"+   , "               { b :: a"+   , "               }"+   , "  deriving (Eq, Show)"+   , "  deriving (ToJSON)"+   ]  case23 :: Assertion-case23 = expected @=? testStep (step indentSameStyle) input-  where-    input = unlines-       [ "data Foo a"-       , "  = Foo { a :: Int,"-       , "          a2 :: String"-       , "          -- ^ some haddock"-       , "        }"-       , "  | Bar { b :: a }  deriving (Eq, Show)"-       , "  deriving (ToJSON)"-       ]--    expected = unlines-       [ "data Foo a"-       , "  = Foo { a :: Int"-       , "        , a2 :: String"-       , "          -- ^ some haddock"-       , "        }"-       , "  | Bar { b :: a"-       , "        }"-       , "  deriving (Eq, Show)"-       , "  deriving (ToJSON)"-       ]+case23 = assertSnippet (step indentSameStyle)+   [ "data Foo a"+   , "  = Foo { a :: Int,"+   , "          a2 :: String"+   , "          -- ^ some haddock"+   , "        }"+   , "  | Bar { b :: a }  deriving (Eq, Show)"+   , "  deriving (ToJSON)"+   ]+   [ "data Foo a"+   , "  = Foo { a :: Int"+   , "        , a2 :: String"+   , "          -- ^ some haddock"+   , "        }"+   , "  | Bar { b :: a"+   , "        }"+   , "  deriving (Eq, Show)"+   , "  deriving (ToJSON)"+   ]  case24 :: Assertion case24 = expected @=? testStep (step indentIndentStyle) input@@ -1200,17 +1193,101 @@       , "  deriving newtype (Applicative, Functor, Monad)"       ] +case55 :: Assertion+case55 = expected @=? testStep (step sameSameNoSortStyle) input+  where+    input = unlines+       [ "data Foo = Foo deriving (Z, Y, X, Bar, Abcd)"+       ]++    expected = input++case56 :: Assertion+case56 = assertSnippet (step defaultConfig)+    [ "data Foo = Foo"+    , "  { -- | Comment"+    , "    bar :: Int"+    , "  , baz :: Int"+    , "  }"+    ]+    [ "data Foo = Foo"+    , "    { -- | Comment"+    , "      bar :: Int"+    , "    , baz :: Int"+    , "    }"+    ]++case57 :: Assertion+case57 = assertSnippet (step defaultConfig)+    [ "data Foo = Foo"+    , "    { {- | A"+    , "      -}"+    , "      fooA :: Int"+    , ""+    , "      {- | B"+    , "      -}"+    , "    , fooB :: Int"+    , ""+    , "      {- | C"+    , "      -}"+    , "    , fooC :: Int"+    , ""+    , "      {- | D"+    , "      -}"+    , "    , fooD :: Int"+    , ""+    , "      {- | E"+    , "      -}"+    , "    , fooE :: Int"+    , ""+    , "      {- | F"+    , "      -}"+    , "    , fooFooFoo :: Int"+    , ""+    , "      {- | G"+    , "      -}"+    , "    , fooBarBar :: Int"+    , "    }"+    ]+    [ "data Foo = Foo"+    , "    { {- | A"+    , "      -}"+    , "      fooA :: Int"+    , "      {- | B"+    , "      -}"+    , "    , fooB :: Int"+    , "      {- | C"+    , "      -}"+    , "    , fooC :: Int"+    , "      {- | D"+    , "      -}"+    , "    , fooD :: Int"+    , "      {- | E"+    , "      -}"+    , "    , fooE :: Int"+    , "      {- | F"+    , "      -}"+    , "    , fooFooFoo :: Int"+    , "      {- | G"+    , "      -}"+    , "    , fooBarBar :: Int"+    , "    }"+    ]+ sameSameStyle :: Config-sameSameStyle = Config SameLine SameLine 2 2 False True SameLine False NoMaxColumns+sameSameStyle = Config SameLine SameLine 2 2 False True SameLine False True NoMaxColumns  sameIndentStyle :: Config-sameIndentStyle = Config SameLine (Indent 2) 2 2 False True SameLine False NoMaxColumns+sameIndentStyle = Config SameLine (Indent 2) 2 2 False True SameLine False True NoMaxColumns  indentSameStyle :: Config-indentSameStyle = Config (Indent 2) SameLine 2 2 False True SameLine False NoMaxColumns+indentSameStyle = Config (Indent 2) SameLine 2 2 False True SameLine False True NoMaxColumns  indentIndentStyle :: Config-indentIndentStyle = Config (Indent 2) (Indent 2) 2 2 False True SameLine False NoMaxColumns+indentIndentStyle = Config (Indent 2) (Indent 2) 2 2 False True SameLine False True NoMaxColumns  indentIndentStyle4 :: Config-indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4 False True SameLine False NoMaxColumns+indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4 False True SameLine False True NoMaxColumns++sameSameNoSortStyle :: Config+sameSameNoSortStyle = Config SameLine SameLine 2 2 False True SameLine False False NoMaxColumns

@@ -61,6 +61,7 @@     , testCase "case 27" case27     , testCase "case 28" case28     , testCase "case 29" case29+    , testCase "case 30" case30     ]  @@ -834,3 +835,10 @@     , ""     , "import A (A)"     ]+++--------------------------------------------------------------------------------+case30 :: Assertion+case30 = assertSnippet (step Nothing defaultOptions {separateLists = False})+    ["import           Data.Monoid (Monoid (..))"]+    ["import           Data.Monoid (Monoid(..))"]

@@ -34,6 +34,7 @@     , testCase "Indents with 2 spaces" ex14     , testCase "Group doc with 2 spaces" ex15     , testCase "Does not sort" ex16+    , testCase "Repects separate_lists" ex17     ]  --------------------------------------------------------------------------------@@ -299,3 +300,14 @@       , "    , no"       , "    ) where"       ]++ex17 :: Assertion+ex17 = assertSnippet (step defaultConfig {separateLists = False})+    [ "module Foo"+    , "    ( Bar (..)"+    , "    ) where"+    ]+    [ "module Foo"+    , "    ( Bar(..)"+    , "    ) where"+    ]

@@ -31,6 +31,12 @@     , testCase "case 10" case10     , testCase "case 11" case11     , testCase "case 12" case12+    , testCase "case 13" case13+    , testCase "case 13b" case13b+    , testCase "case 14" case14+    , testCase "case 15" case15+    , testCase "case 16" case16+    , testCase "case 17" case17     ]  @@ -192,10 +198,108 @@  -------------------------------------------------------------------------------- case12 :: Assertion-case12 = assertSnippet (step Nothing defaultConfig {cCases = False}) input input+case12 = assertSnippet (step Nothing defaultConfig { cCases = Never }) input input   where     input =         [ "case x of"         , "  Just y -> 1"         , "  Nothing -> 2"         ]+++--------------------------------------------------------------------------------+case13 :: Assertion+case13 = assertSnippet (step Nothing defaultConfig)+    [ "cond n = if"+    , "    | n < 10, x <- 1 -> x"+    , "    | otherwise -> 2"+    ]+    [ "cond n = if"+    , "    | n < 10, x <- 1 -> x"+    , "    | otherwise      -> 2"+    ]++case13b :: Assertion+case13b = assertSnippet (step Nothing defaultConfig {cMultiWayIf = Never})+    [ "cond n = if"+    , "    | n < 10, x <- 1 -> x"+    , "    | otherwise -> 2"+    ]+    [ "cond n = if"+    , "    | n < 10, x <- 1 -> x"+    , "    | otherwise -> 2"+    ]+++--------------------------------------------------------------------------------+case14 :: Assertion+case14 = assertSnippet (step (Just 80) defaultConfig { cCases = Adjacent })+    [ "catch e = case e of"+    , "    Left GoodError -> 1"+    , "    Left BadError -> 2"+    , "    -- otherwise"+    , "    Right [] -> 0"+    , "    Right (x:_) -> x"+    ]+    [ "catch e = case e of"+    , "    Left GoodError -> 1"+    , "    Left BadError  -> 2"+    , "    -- otherwise"+    , "    Right []    -> 0"+    , "    Right (x:_) -> x"+    ]+++--------------------------------------------------------------------------------+case15 :: Assertion+case15 = assertSnippet (step (Just 80) defaultConfig { cTopLevelPatterns = Adjacent })+    [ "catch (Left GoodError) = 1"+    , "catch (Left BadError) = 2"+    , "-- otherwise"+    , "catch (Right []) = 0"+    , "catch (Right (x:_)) = x"+    ]+    [ "catch (Left GoodError) = 1"+    , "catch (Left BadError)  = 2"+    , "-- otherwise"+    , "catch (Right [])    = 0"+    , "catch (Right (x:_)) = x"+    ]+++--------------------------------------------------------------------------------+case16 :: Assertion+case16 = assertSnippet (step (Just 80) defaultConfig { cRecords = Adjacent })+    [ "data Foo = Foo"+    , "    { foo :: Int"+    , "    , foo2 :: String"+    , "      -- a comment"+    , "    , barqux :: String"+    , "    , baz :: String"+    , "    , baz2 :: Bool"+    , "    } deriving (Show)"+    ]+    [ "data Foo = Foo"+    , "    { foo  :: Int"+    , "    , foo2 :: String"+    , "      -- a comment"+    , "    , barqux :: String"+    , "    , baz    :: String"+    , "    , baz2   :: Bool"+    , "    } deriving (Show)"+    ]+++--------------------------------------------------------------------------------+case17 :: Assertion+case17 = assertSnippet (step Nothing defaultConfig { cMultiWayIf = Adjacent })+    [ "cond n = if"+    , "    | n < 10, x <- 1 -> x"+    , "    -- comment"+    , "    | otherwise -> 2"+    ]+    [ "cond n = if"+    , "    | n < 10, x <- 1 -> x"+    , "    -- comment"+    , "    | otherwise -> 2"+    ]

@@ -1,13 +1,14 @@ --------------------------------------------------------------------------------+{-# LANGUAGE OverloadedLists #-} module Language.Haskell.Stylish.Step.Squash.Tests     ( tests     ) where   ---------------------------------------------------------------------------------import           Test.Framework                            (Test, testGroup)-import           Test.Framework.Providers.HUnit            (testCase)-import           Test.HUnit                                (Assertion, (@=?))+import           Test.Framework                       (Test, testGroup)+import           Test.Framework.Providers.HUnit       (testCase)+import           Test.HUnit                           (Assertion)   --------------------------------------------------------------------------------@@ -28,94 +29,74 @@  -------------------------------------------------------------------------------- case01 :: Assertion-case01 = expected @=? testStep step input-  where-    input = unlines-        [ "data Foo = Foo"-        , "    { foo    :: Int"-        , "    , barqux :: String"-        , "    } deriving (Show)"-        ]--    expected = unlines-        [ "data Foo = Foo"-        , "    { foo :: Int"-        , "    , barqux :: String"-        , "    } deriving (Show)"-        ]+case01 = assertSnippet step+    [ "data Foo = Foo"+    , "    { foo    :: Int"+    , "    , barqux :: String"+    , "    } deriving (Show)"+    ]+    [ "data Foo = Foo"+    , "    { foo :: Int"+    , "    , barqux :: String"+    , "    } deriving (Show)"+    ]   -------------------------------------------------------------------------------- case02 :: Assertion-case02 = expected @=? testStep step input-  where-    input = unlines-        [ "data Foo = Foo"-        , "    { fooqux"-        , "    , bar    :: String"-        , "    } deriving (Show)"-        ]--    expected = unlines-        [ "data Foo = Foo"-        , "    { fooqux"-        , "    , bar :: String"-        , "    } deriving (Show)"-        ]+case02 = assertSnippet step+    [ "data Foo = Foo"+    , "    { fooqux"+    , "    , bar    :: String"+    , "    } deriving (Show)"+    ]+    [ "data Foo = Foo"+    , "    { fooqux"+    , "    , bar :: String"+    , "    } deriving (Show)"+    ]   -------------------------------------------------------------------------------- case03 :: Assertion-case03 = expected @=? testStep step input-  where-    input = unlines-        [ "maybe y0 f mx ="-        , "    case mx of"-        , "        Nothing -> y0"-        , "        Just x  -> f x"-        ]--    expected = unlines-        [ "maybe y0 f mx ="-        , "    case mx of"-        , "        Nothing -> y0"-        , "        Just x -> f x"-        ]+case03 = assertSnippet step+    [ "maybe y0 f mx ="+    , "    case mx of"+    , "        Nothing -> y0"+    , "        Just x  -> f x"+    ]+    [ "maybe y0 f mx ="+    , "    case mx of"+    , "        Nothing -> y0"+    , "        Just x -> f x"+    ]   -------------------------------------------------------------------------------- case04 :: Assertion-case04 = expected @=? testStep step input-  where-    input = unlines-        [ "maybe y0 f mx ="-        , "    case mx of"-        , "        Nothing ->"-        , "            y0"-        , "        Just x  ->"-        , "            f x"-        ]--    expected = unlines-        [ "maybe y0 f mx ="-        , "    case mx of"-        , "        Nothing ->"-        , "            y0"-        , "        Just x ->"-        , "            f x"-        ]+case04 = assertSnippet step+    [ "maybe y0 f mx ="+    , "    case mx of"+    , "        Nothing ->"+    , "            y0"+    , "        Just x  ->"+    , "            f x"+    ]+    [ "maybe y0 f mx ="+    , "    case mx of"+    , "        Nothing ->"+    , "            y0"+    , "        Just x ->"+    , "            f x"+    ]   -------------------------------------------------------------------------------- case05 :: Assertion-case05 = expected @=? testStep step input-  where-    input = unlines-        [ "maybe y0 _ Nothing  = y"-        , "maybe _  f (Just x) = f x"-        ]--    expected = unlines-        [ "maybe y0 _ Nothing = y"-        , "maybe _  f (Just x) = f x"-        ]+case05 = assertSnippet step+    [ "maybe y0 _ Nothing  = y"+    , "maybe _  f (Just x) = f x"+    ]+    [ "maybe y0 _ Nothing = y"+    , "maybe _  f (Just x) = f x"+    ]