stylish-haskell 0.10.0.0 → 0.11.0.0

raw patch · 11 files changed

+580/−147 lines, 11 filesdep +textPVP ok

version bump matches the API change (PVP)

Dependencies added: text

API changes (from Hackage documentation)

Files

• CHANGELOG +6/−0
• README.markdown +56/−0
• data/stylish-haskell.yaml +27/−5
• lib/Language/Haskell/Stylish.hs +41/−1
• lib/Language/Haskell/Stylish/Config.hs +21/−4
• lib/Language/Haskell/Stylish/Step/Data.hs +74/−22
• src/Main.hs +21/−9
• stylish-haskell.cabal +3/−1
• tests/Language/Haskell/Stylish/Config/Tests.hs +5/−2
• tests/Language/Haskell/Stylish/Step/Data/Tests.hs +236/−91
• tests/Language/Haskell/Stylish/Tests.hs +90/−12

@@ -1,5 +1,11 @@ # CHANGELOG +- 0.11.0.0 (2020-02-24)+    * Disable record formatting by default+    * Allow more customization for record formatting (by Maxim Koltsov)+    * Disable formatting of data types without records (by Maxim Koltsov)+    * Add `-r` flag to recursively find Haskell files (by Akos Marton)+ - 0.10.0.0 (2020-01-26)     * Switch to HsYAML library (by vijayphoenix)     * Expose `format` from main library (by Łukasz Gołębiewski)

@@ -33,6 +33,7 @@ - Replaces tabs by four spaces (turned off by default) - Replaces some ASCII sequences by their Unicode equivalents (turned off by   default)+- Format data constructors and fields in records.  Feature requests are welcome! Use the [issue tracker] for that. @@ -101,6 +102,61 @@ Use `stylish-haskell --defaults > .stylish-haskell.yaml` to dump a well-documented default configuration to a file, this way you can get started quickly.++## Record formatting++Basically, stylish-haskell supports 4 different styles of records, controlled by `records`+in the config file.++Here's an example of all four styles:++```haskell+-- equals: "indent 2", "first_field": "indent 2"+data Foo a+  = Foo+      { a :: Int+      , a2 :: String+        -- ^ some haddock+      }+  | Bar+      { b :: a+      }+  deriving (Eq, Show)+  deriving (ToJSON) via Bar Foo++-- equals: "same_line", "first_field": "indent 2"+data Foo a = Foo+               { a :: Int+               , a2 :: String+                 -- ^ some haddock+               }+           | Bar+               { b :: a+               }+  deriving (Eq, Show)+  deriving (ToJSON) via Bar Foo++-- equals: "same_line", "first_field": "same_line"+data Foo a = Foo { a :: Int+                 , a2 :: String+                   -- ^ some haddock+                 }+           | Bar { b :: a+                 }+  deriving (Eq, Show)+  deriving (ToJSON) via Bar Foo++-- equals: "indent 2", first_field: "same_line"+data Foo a+  = Foo { a :: Int+        , a2 :: String+          -- ^ some haddock+        }+  | Bar { b :: a+        }+  deriving (Eq, Show)+  deriving (ToJSON) via Bar Foo+```  ## VIM integration 

@@ -15,8 +15,33 @@   #     # true.   #     add_language_pragma: true -  # Format record definitions-  - records: {}+  # Format record definitions. This is disabled by default.+  #+  # You can control the layout of record fields. The only rules that can't be configured+  # are these:+  #+  # - "|" is always aligned with "="+  # - "," in fields is always aligned with "{"+  # - "}" is likewise always aligned with "{"+  #+  # - records:+  #     # How to format equals sign between type constructor and data constructor.+  #     # Possible values:+  #     # - "same_line" -- leave "=" AND data constructor on the same line as the type constructor.+  #     # - "indent N" -- insert a new line and N spaces from the beginning of the next line.+  #     equals: "indent 2"+  #+  #     # How to format first field of each record constructor.+  #     # 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+  #     first_field: "indent 2"+  #+  #     # How many spaces to insert between the column with "," and the beginning of the comment in the next line.+  #     field_comment: 2+  #+  #     # How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines.+  #     deriving: 2    # Align the right hand side of some elements.  This is quite conservative   # and only applies to statements where each element occupies a single@@ -224,9 +249,6 @@   # elements into single spaces. Basically, this undoes the effect of   # simple_align but is a bit less conservative.   # - squash: {}--# A common indentation setting. Different steps take this into account.-indent: 4  # A common setting is the number of columns (parts of) code will be wrapped # to. Different steps take this into account.

@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} -------------------------------------------------------------------------------- module Language.Haskell.Stylish     ( -- * Run@@ -10,6 +11,7 @@     , trailingWhitespace     , unicodeSyntax       -- ** Helpers+    , findHaskellFiles     , stepName       -- * Config     , module Language.Haskell.Stylish.Config@@ -25,7 +27,11 @@  -------------------------------------------------------------------------------- import           Control.Monad                                    (foldM)-+import           System.Directory                                 (doesDirectoryExist,+                                                                   doesFileExist,+                                                                   listDirectory)+import           System.FilePath                                  (takeExtension,+                                                                   (</>))  -------------------------------------------------------------------------------- import           Language.Haskell.Stylish.Config@@ -103,3 +109,37 @@ format maybeConfigPath maybeFilePath contents = do   conf <- loadConfig (makeVerbose True) (fmap unConfigPath maybeConfigPath)   pure $ runSteps (configLanguageExtensions conf) maybeFilePath (configSteps conf) $ lines contents+++--------------------------------------------------------------------------------+-- | Searches Haskell source files in any given folder recursively.+findHaskellFiles :: Bool -> [FilePath] -> IO [FilePath]+findHaskellFiles v fs = mapM (findFilesR v) fs >>= return . concat+++--------------------------------------------------------------------------------+findFilesR :: Bool -> FilePath -> IO [FilePath]+findFilesR _ []   = return []+findFilesR v path = do+  doesFileExist path >>= \case+    True -> return [path]+    _    -> doesDirectoryExist path >>= \case+      True  -> findFilesRecursive path >>=+        return . filter (\x -> takeExtension x == ".hs")+      False -> do+        makeVerbose v ("Input folder does not exists: " <> path)+        findFilesR v []+  where+    findFilesRecursive :: FilePath -> IO [FilePath]+    findFilesRecursive = listDirectoryFiles findFilesRecursive++    listDirectoryFiles :: (FilePath -> IO [FilePath])+                       -> FilePath -> IO [FilePath]+    listDirectoryFiles go topdir = do+      ps <- listDirectory topdir >>=+        mapM (\x -> do+                 let dir = topdir </> x+                 doesDirectoryExist dir >>= \case+                   True  -> go dir+                   False -> return [dir])+      return $ concat ps

@@ -24,12 +24,14 @@ import           Data.Map                                         (Map) import qualified Data.Map                                         as M import           Data.Maybe                                       (fromMaybe)+import qualified Data.Text                                        as T import           Data.YAML                                        (prettyPosWithSource) import           Data.YAML.Aeson                                  (decode1Strict) import           System.Directory import           System.FilePath                                  ((</>)) import qualified System.IO                                        as IO (Newline (..),                                                                          nativeNewline)+import           Text.Read                                        (readMaybe)   --------------------------------------------------------------------------------@@ -54,7 +56,6 @@ -------------------------------------------------------------------------------- data Config = Config     { configSteps              :: [Step]-    , configIndent             :: Int     , configColumns            :: Maybe Int     , configLanguageExtensions :: [String]     , configNewline            :: IO.Newline@@ -121,7 +122,6 @@     -- First load the config without the actual steps     config <- Config         <$> pure []-        <*> (o A..:? "indent"              A..!= 4)         <*> (o A..:! "columns"             A..!= Just 80)         <*> (o A..:? "language_extensions" A..!= [])         <*> (o A..:? "newline"             >>= parseEnum newlines IO.nativeNewline)@@ -186,8 +186,25 @@  -------------------------------------------------------------------------------- parseRecords :: Config -> A.Object -> A.Parser Step-parseRecords c _ = Data.step-    <$> pure (configIndent c)+parseRecords _ o = Data.step+    <$> (Data.Config+        <$> (o A..: "equals" >>= parseIndent)+        <*> (o A..: "first_field" >>= parseIndent)+        <*> (o A..: "field_comment")+        <*> (o A..: "deriving"))+++parseIndent :: A.Value -> A.Parser Data.Indent+parseIndent = A.withText "Indent" $ \t ->+  if t == "same_line"+     then return Data.SameLine+     else+         if "indent " `T.isPrefixOf` t+             then+                 case readMaybe (T.unpack $ T.drop 7 t) of+                     Just n -> return $ Data.Indent n+                     Nothing -> fail $ "Indent: not a number" <> T.unpack (T.drop 7 t)+             else fail $ "can't parse indent setting: " <> T.unpack t   --------------------------------------------------------------------------------

@@ -1,7 +1,9 @@+{-# LANGUAGE RecordWildCards #-}+ module Language.Haskell.Stylish.Step.Data where  import           Data.List                       (find, intercalate)-import           Data.Maybe                      (maybeToList)+import           Data.Maybe                      (fromMaybe, maybeToList) import qualified Language.Haskell.Exts           as H import           Language.Haskell.Exts.Comments import           Language.Haskell.Stylish.Block@@ -10,20 +12,36 @@ import           Language.Haskell.Stylish.Util import           Prelude                         hiding (init) +data Indent+    = SameLine+    | Indent !Int+  deriving (Show)++data Config = Config+    { cEquals           :: !Indent+      -- ^ Indent between type constructor and @=@ sign (measured from column 0)+    , cFirstField       :: !Indent+      -- ^ Indent between data constructor and @{@ line (measured from column with data constructor name)+    , cFieldComment     :: !Int+      -- ^ Indent between column with @{@ and start of field line comment (this line has @cFieldComment = 2@)+    , cDeriving         :: !Int+      -- ^ Indent before @deriving@ lines (measured from column 0)+    } deriving (Show)+ datas :: H.Module l -> [H.Decl l] datas (H.Module _ _ _ _ decls) = decls datas _                        = []  type ChangeLine = Change String -step :: Int -> Step-step indentSize = makeStep "Data" (step' indentSize)+step :: Config -> Step+step cfg = makeStep "Data" (step' cfg) -step' :: Int -> Lines -> Module -> Lines-step' indentSize ls (module', allComments) = applyChanges changes ls+step' :: Config -> Lines -> Module -> Lines+step' cfg ls (module', allComments) = applyChanges changes ls   where     datas' = datas $ fmap linesFromSrcSpan module'-    changes = datas' >>= maybeToList . changeDecl allComments indentSize+    changes = datas' >>= maybeToList . changeDecl allComments cfg  findCommentOnLine :: LineBlock -> [Comment] -> Maybe Comment findCommentOnLine lb = find commentOnLine@@ -43,32 +61,66 @@     within (Comment _ (H.SrcSpan _ start _ end _) _) =       start >= blockStart lb && end <= blockEnd lb -changeDecl :: [Comment] -> Int -> H.Decl LineBlock -> Maybe ChangeLine+changeDecl :: [Comment] -> Config -> H.Decl LineBlock -> Maybe ChangeLine changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing-changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) =-  Just $ change block (const $ concat newLines)+changeDecl allComments cfg@Config{..} (H.DataDecl block (H.DataType _) Nothing dhead decls derivings)+  | hasRecordFields = Just $ change block (const $ concat newLines)+  | otherwise       = Nothing   where-    newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings]+    hasRecordFields = any+      (\qual -> case qual of+                  (H.QualConDecl _ _ _ (H.RecDecl {})) -> True+                  _ -> False)+      decls++    typeConstructor = "data " <> H.prettyPrint dhead++    -- In any case set @pipeIndent@ such that @|@ is aligned with @=@.+    (firstLine, firstLineInit, pipeIndent) =+      case cEquals of+        SameLine -> (Nothing, typeConstructor <> " = ", length typeConstructor + 1)+        Indent n -> (Just [[typeConstructor]], indent n "= ", n)++    newLines = fromMaybe [] firstLine ++ fmap constructors zipped <> [fmap (indent cDeriving . H.prettyPrint) derivings]     zipped = zip decls ([1..] ::[Int])-    constructors (decl, 1) = processConstructor allComments typeConstructor indentSize decl-    constructors (decl, _) = processConstructor allComments (indented "| ") indentSize decl-    typeConstructor = "data " <> H.prettyPrint dhead <> " = "-    indented = indent indentSize++    constructors (decl, 1) = processConstructor allComments firstLineInit cfg decl+    constructors (decl, _) = processConstructor allComments (indent pipeIndent "| ") cfg decl changeDecl _ _ _ = Nothing -processConstructor :: [Comment] -> String -> Int -> H.QualConDecl LineBlock -> [String]-processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do-  init <> H.prettyPrint dname : n1 ++ ns ++ [indented "}"]+processConstructor :: [Comment] -> String -> Config -> H.QualConDecl LineBlock -> [String]+processConstructor allComments init Config{..} (H.QualConDecl _ _ _ (H.RecDecl _ dname (f:fs))) = do+  fromMaybe [] firstLine <> n1 <> ns <> [indent fieldIndent "}"]   where-    n1 = processName "{ " ( extractField $ head fields)-    ns = tail fields >>= (processName ", " . extractField)+    n1 = processName firstLinePrefix (extractField f)+    ns = fs >>= processName (indent fieldIndent ", ") . extractField++    -- Set @fieldIndent@ such that @,@ is aligned with @{@.+    (firstLine, firstLinePrefix, fieldIndent) =+      case cFirstField of+        SameLine ->+          ( Nothing+          , init <> H.prettyPrint dname <> " { "+          , length init + length (H.prettyPrint dname) + 1+          )+        Indent n ->+          ( Just [init <> H.prettyPrint dname]+          , indent (length init + n) "{ "+          , length init + n+          )+     processName prefix (fnames, _type, lineComment, commentBelowLine) =-      [indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> addLineComment lineComment] ++ addCommentBelow commentBelowLine+      [prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> addLineComment lineComment+      ] ++ addCommentBelow commentBelowLine+     addLineComment (Just (Comment _ _ c)) = " --" <> c     addLineComment Nothing                = ""++    -- Field comment indent is measured from the column with @{@, hence adding of @fieldIndent@ here.     addCommentBelow Nothing                = []-    addCommentBelow (Just (Comment _ _ c)) = [indented "--" <> c]+    addCommentBelow (Just (Comment _ _ c)) = [indent (fieldIndent + cFieldComment) "--" <> c]+     extractField (H.FieldDecl lb names _type) =       (names, _type, findCommentOnLine lb allComments, findCommentBelowLine lb allComments)-    indented = indent indentSize+ processConstructor _ init _ decl = [init <> trimLeft (H.prettyPrint decl)]

@@ -21,13 +21,14 @@  -------------------------------------------------------------------------------- data StylishArgs = StylishArgs-    { saVersion  :: Bool-    , saConfig   :: Maybe FilePath-    , saVerbose  :: Bool-    , saDefaults :: Bool-    , saInPlace  :: Bool-    , saNoUtf8   :: Bool-    , saFiles    :: [FilePath]+    { saVersion   :: Bool+    , saConfig    :: Maybe FilePath+    , saRecursive :: Bool+    , saVerbose   :: Bool+    , saDefaults  :: Bool+    , saInPlace   :: Bool+    , saNoUtf8    :: Bool+    , saFiles     :: [FilePath]     } deriving (Show)  @@ -45,6 +46,11 @@             OA.short   'c'                   <>             OA.hidden)     <*> OA.switch (+            OA.help    "Recursive file search" <>+            OA.long    "recursive"             <>+            OA.short   'r'                     <>+            OA.hidden)+    <*> OA.switch (             OA.help  "Run in verbose mode" <>             OA.long  "verbose"             <>             OA.short 'v'                   <>@@ -99,14 +105,20 @@          else do             conf <- loadConfig verbose' (saConfig sa)+            filesR <- case (saRecursive sa) of+              True -> findHaskellFiles (saVerbose sa) (saFiles sa)+              _    -> return $ saFiles sa             let steps = configSteps conf             forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step"             verbose' $ "Extra language extensions: " ++                 show (configLanguageExtensions conf)-            mapM_ (file sa conf) files'+            mapM_ (file sa conf) $ files' filesR   where     verbose' = makeVerbose (saVerbose sa)-    files'   = if null (saFiles sa) then [Nothing] else map Just (saFiles sa)+    files' x = case (saRecursive sa, null x) of+      (True,True) -> []         -- No file to format and recursive enabled.+      (_,True)    -> [Nothing]  -- Involving IO.stdin.+      (_,False)   -> map Just x -- Process available files.   --------------------------------------------------------------------------------

@@ -1,5 +1,5 @@ Name:          stylish-haskell-Version:       0.10.0.0+Version:       0.11.0.0 Synopsis:      Haskell code prettifier Homepage:      https://github.com/jaspervdj/stylish-haskell License:       BSD3@@ -64,6 +64,7 @@     mtl              >= 2.0    && < 2.3,     semigroups       >= 0.18   && < 0.20,     syb              >= 0.3    && < 0.8,+    text             >= 1.2    && < 1.3,     HsYAML-aeson     >=0.2.0   && < 0.3,     HsYAML           >=0.2.0   && < 0.3 @@ -148,6 +149,7 @@     haskell-src-exts >= 1.18   && < 1.24,     mtl              >= 2.0    && < 2.3,     syb              >= 0.3    && < 0.8,+    text             >= 1.2    && < 1.3,     HsYAML-aeson     >=0.2.0   && < 0.3,     HsYAML           >=0.2.0   && < 0.3 

@@ -148,8 +148,11 @@   , "      align: false"   , "      remove_redundant: true"   , "  - trailing_whitespace: {}"-  , "  - records: {}"-  , "indent: 2"+  , "  - records:"+  , "      equals: \"same_line\""+  , "      first_field: \"indent 2\""+  , "      field_comment: 2"+  , "      deriving: 4"   , "columns: 110"   , "language_extensions:"   , "  - TemplateHaskell"

@@ -30,10 +30,15 @@     , testCase "case 17" case17     , testCase "case 18" case18     , testCase "case 19" case19+    , testCase "case 20 (issue 262)" case20+    , testCase "case 21" case21+    , testCase "case 22" case22+    , testCase "case 23" case23+    , testCase "case 24" case24     ]  case00 :: Assertion-case00 = expected @=? testStep (step 2) input+case00 = expected @=? testStep (step sameSameStyle) input   where     input = unlines       [ "module Herp where"@@ -44,7 +49,7 @@     expected = input  case01 :: Assertion-case01 = expected @=? testStep (step 2) input+case01 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines       [ "module Herp where"@@ -55,13 +60,14 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo = Foo"-       , "  { a :: Int"-       , "  }"+       , "data Foo"+       , "  = Foo"+       , "      { a :: Int"+       , "      }"        ]  case02 :: Assertion-case02 = expected @=? testStep (step 2) input+case02 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines       [ "module Herp where"@@ -71,14 +77,15 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo = Foo"-       , "  { a :: Int"-       , "  , a2 :: String"-       , "  }"+       , "data Foo"+       , "  = Foo"+       , "      { a :: Int"+       , "      , a2 :: String"+       , "      }"        ]  case03 :: Assertion-case03 = expected @=? testStep (step 2) input+case03 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines       [ "module Herp where"@@ -88,14 +95,15 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo a = Foo"-       , "  { a :: a"-       , "  , a2 :: String"-       , "  }"+       , "data Foo a"+       , "  = Foo"+       , "      { a :: a"+       , "      , a2 :: String"+       , "      }"        ]  case04 :: Assertion-case04 = expected @=? testStep (step 2) input+case04 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines       [ "module Herp where"@@ -105,17 +113,18 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo a = Foo"-       , "  { a :: a"-       , "  , a2 :: String"-       , "  }"+       , "data Foo a"+       , "  = Foo"+       , "      { a :: a"+       , "      , a2 :: String"+       , "      }"        , "  | Bar"-       , "  { b :: a"-       , "  }"+       , "      { b :: a"+       , "      }"        ]  case05 :: Assertion-case05 = expected @=? testStep (step 2) input+case05 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines        [ "module Herp where"@@ -128,14 +137,15 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo = Foo"-       , "  { a :: Int"-       , "  , a2 :: String"-       , "  }"+       , "data Foo"+       , "  = Foo"+       , "      { a :: Int"+       , "      , a2 :: String"+       , "      }"        ]  case06 :: Assertion-case06 = expected @=? testStep (step 2) input+case06 = expected @=? testStep (step sameSameStyle) input   where     input = unlines       [ "module Herp where"@@ -145,7 +155,7 @@     expected = input  case07 :: Assertion-case07 = expected @=? testStep (step 2) input+case07 = expected @=? testStep (step sameSameStyle) input   where     input = unlines       [ "module Herp where"@@ -155,7 +165,7 @@     expected = input  case08 :: Assertion-case08 = expected @=? testStep (step 2) input+case08 = input @=? testStep (step sameSameStyle) input   where     input = unlines       [ "module Herp where"@@ -163,14 +173,9 @@       , "data Phantom a ="       , "  Phantom"       ]-    expected = unlines-      [ "module Herp where"-      , ""-      , "data Phantom a = Phantom"-      ]  case09 :: Assertion-case09 = expected @=? testStep (step 4) input+case09 = expected @=? testStep (step indentIndentStyle4) input   where     input = unlines       [ "module Herp where"@@ -180,18 +185,19 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo a b = Foo"-       , "    { a :: a"-       , "    , a2 :: String"-       , "    }"+       , "data Foo a b"+       , "    = Foo"+       , "          { a :: a"+       , "          , a2 :: String"+       , "          }"        , "    | Bar"-       , "    { b :: a"-       , "    , c :: b"-       , "    }"+       , "          { b :: a"+       , "          , c :: b"+       , "          }"        ]  case10 :: Assertion-case10 = expected @=? testStep (step 2) input+case10 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines       [ "module Herp where"@@ -202,15 +208,16 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo = Foo"-       , "  { a :: Int"-       , "  }"+       , "data Foo"+       , "  = Foo"+       , "      { a :: Int"+       , "      }"        , "  deriving (Eq, Generic)"        , "  deriving (Show)"        ]  case11 :: Assertion-case11 = expected @=? testStep (step 2) input+case11 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines       [ "{-# LANGUAGE DerivingStrategies #-}"@@ -223,14 +230,15 @@        [ "{-# LANGUAGE DerivingStrategies #-}"        , "module Herp where"        , ""-       , "data Foo = Foo"-       , "  { a :: Int"-       , "  }"+       , "data Foo"+       , "  = Foo"+       , "      { a :: Int"+       , "      }"        , "  deriving stock (Show)"        ]  case12 :: Assertion-case12 = expected @=? testStep (step 4) input+case12 = expected @=? testStep (step indentIndentStyle4) input   where     input = unlines       [ "module Herp where"@@ -241,15 +249,16 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Point = Point"-       , "    { pointX, pointY :: Double"-       , "    , pointName :: String"-       , "    }"+       , "data Point"+       , "    = Point"+       , "          { pointX, pointY :: Double"+       , "          , pointName :: String"+       , "          }"        , "    deriving (Show)"        ]  case13 :: Assertion-case13 = expected @=? testStep (step 2) input+case13 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines       [ "module Herp where"@@ -261,13 +270,14 @@       [ "module Herp where"       , ""       , "-- this is a comment"-      , "data Foo = Foo"-      , "  { a :: Int"-      , "  }"+      , "data Foo"+      , "  = Foo"+      , "      { a :: Int"+      , "      }"       ]  case14 :: Assertion-case14 = expected @=? testStep (step 2) input+case14 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines       [ "module Herp where"@@ -281,13 +291,14 @@       , ""       , "{- this is"       , "   a comment -}"-      , "data Foo = Foo"-      , "  { a :: Int"-      , "  }"+      , "data Foo"+      , "  = Foo"+      , "      { a :: Int"+      , "      }"       ]  case15 :: Assertion-case15 = expected @=? testStep (step 2) input+case15 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines        [ "module Herp where"@@ -300,14 +311,15 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo a = Foo"-       , "  { a :: a -- comment"-       , "  , a2 :: String"-       , "  }"+       , "data Foo a"+       , "  = Foo"+       , "      { a :: a -- comment"+       , "      , a2 :: String"+       , "      }"        ]  case16 :: Assertion-case16 = expected @=? testStep (step 2) input+case16 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines       [ "module Herp where"@@ -319,13 +331,14 @@     expected = unlines       [ "module Herp where"       , ""-      , "data Foo = Foo"-      , "  { a :: Int -- ^ comment"-      , "  }"+      , "data Foo"+      , "  = Foo"+      , "      { a :: Int -- ^ comment"+      , "      }"       ]  case17 :: Assertion-case17 = expected @=? testStep (step 2) input+case17 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines        [ "module Herp where"@@ -339,15 +352,16 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo a = Foo"-       , "  { a :: a"-       , "  -- comment"-       , "  , a2 :: String"-       , "  }"+       , "data Foo a"+       , "  = Foo"+       , "      { a :: a"+       , "        -- comment"+       , "      , a2 :: String"+       , "      }"        ]  case18 :: Assertion-case18 = expected @=? testStep (step 2) input+case18 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines        [ "module Herp where"@@ -361,15 +375,16 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo a = Foo"-       , "  { a :: a"-       , "  -- ^ comment"-       , "  , a2 :: String"-       , "  }"+       , "data Foo a"+       , "  = Foo"+       , "      { a :: a"+       , "        -- ^ comment"+       , "      , a2 :: String"+       , "      }"        ]  case19 :: Assertion-case19 = expected @=? testStep (step 2) input+case19 = expected @=? testStep (step indentIndentStyle) input   where     input = unlines        [ "module Herp where"@@ -383,9 +398,139 @@     expected = unlines        [ "module Herp where"        , ""-       , "data Foo a = Foo"-       , "  { firstName, lastName :: String"-       , "  -- ^ names"-       , "  , age :: Int"-       , "  }"+       , "data Foo a"+       , "  = Foo"+       , "      { firstName, lastName :: String"+       , "        -- ^ names"+       , "      , age :: Int"+       , "      }"        ]++-- | Should not break Enums (data without records) formatting+--+-- See https://github.com/jaspervdj/stylish-haskell/issues/262+case20 :: Assertion+case20 = input @=? testStep (step indentIndentStyle) input+  where+    input = unlines+       [ "module Herp where"+       , ""+       , "data Tag = Title | Text deriving (Eq, Show)"+       ]++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)"+       ]++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)"+       ]++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)"+       ]++case24 :: Assertion+case24 = expected @=? testStep (step indentIndentStyle) 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)"+       ]++sameSameStyle :: Config+sameSameStyle = Config SameLine SameLine 2 2++sameIndentStyle :: Config+sameIndentStyle = Config SameLine (Indent 2) 2 2++indentSameStyle :: Config+indentSameStyle = Config (Indent 2) SameLine 2 2++indentIndentStyle :: Config+indentIndentStyle = Config (Indent 2) (Indent 2) 2 2++indentIndentStyle4 :: Config+indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4

@@ -5,6 +5,9 @@   --------------------------------------------------------------------------------+import           Data.List                           (sort)+import           System.Directory                    (createDirectory)+import           System.FilePath                     (normalise, (</>)) import           Test.Framework                      (Test, testGroup) import           Test.Framework.Providers.HUnit      (testCase) import           Test.HUnit                          (Assertion, (@?=))@@ -17,10 +20,14 @@  -------------------------------------------------------------------------------- tests :: Test-tests = testGroup "Language.Haskell.Stylish.Step.Tabs.Tests"+tests = testGroup "Language.Haskell.Stylish.Tests"     [ testCase "case 01" case01     , testCase "case 02" case02     , testCase "case 03" case03+    , testCase "case 04" case04+    , testCase "case 05" case05+    , testCase "case 06" case06+    , testCase "case 07" case07     ]  @@ -28,11 +35,8 @@ case01 :: Assertion case01 = (@?= result) =<< format Nothing Nothing input   where-    input = "module Herp where\n data Foo = Bar | Baz"-    result = Right [ "module Herp where"-                   , "data Foo = Bar"-                   , "    | Baz"-                   ]+    input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }"+    result = Right $ lines input   --------------------------------------------------------------------------------@@ -40,27 +44,101 @@ case02 = withTestDirTree $ do     writeFile "test-config.yaml" $ unlines         [ "steps:"-        , "  - records: {}"-        , "indent: 2"+        , "  - records:"+        , "      equals: \"indent 2\""+        , "      first_field: \"indent 2\""+        , "      field_comment: 2"+        , "      deriving: 2"         ]      actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input     actual @?= result   where-    input = "module Herp where\n data Foo = Bar | Baz"+    input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }"     result = Right [ "module Herp where"-                   , "data Foo = Bar"+                   , "data Foo"+                   , "  = Bar"                    , "  | Baz"+                   , "      { baz :: Int"+                   , "      }"                    ] - -------------------------------------------------------------------------------- case03 :: Assertion-case03 = (@?= result) =<< format Nothing (Just fileLocation) input+case03 = withTestDirTree $ do+    writeFile "test-config.yaml" $ unlines+        [ "steps:"+        , "  - records:"+        , "      equals: \"same_line\""+        , "      first_field: \"same_line\""+        , "      field_comment: 2"+        , "      deriving: 2"+        ]++    actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input+    actual @?= result   where+    input = unlines [ "module Herp where"+                    , "data Foo"+                    , "  = Bar"+                    , "  | Baz"+                    , "      { baz :: Int"+                    , "      }"+                    ]+    result = Right [ "module Herp where"+                   , "data Foo = Bar"+                   , "         | Baz { baz :: Int"+                   , "               }"+                   ]++--------------------------------------------------------------------------------+case04 :: Assertion+case04 = (@?= result) =<< format Nothing (Just fileLocation) input+  where     fileLocation = "directory/File.hs"     input = "module Herp"     result = Left $       "Language.Haskell.Stylish.Parse.parseModule: could not parse " <>       fileLocation <>       ": ParseFailed (SrcLoc \"<unknown>.hs\" 2 1) \"Parse error: EOF\""+++--------------------------------------------------------------------------------+-- | When providing current dir including folders and files.+case05 :: Assertion+case05 = withTestDirTree $ do+  createDirectory aDir >> writeFile c fileCont+  mapM_ (flip writeFile fileCont) fs+  result <- findHaskellFiles False input+  sort result @?= (sort $ map normalise expected)+  where+    input    = c : fs+    fs = ["b.hs", "a.hs"]+    c  = aDir </> "c.hs"+    aDir     = "aDir"+    expected = ["a.hs", "b.hs", c]+    fileCont = ""+++--------------------------------------------------------------------------------+-- | When the input item is not file, do not recurse it.+case06 :: Assertion+case06 = withTestDirTree $ do+  mapM_ (flip writeFile "") input+  result <- findHaskellFiles False input+  result @?= expected+  where+    input    = ["b.hs"]+    expected = map normalise input+++--------------------------------------------------------------------------------+-- | Empty input should result in empty output.+case07 :: Assertion+case07 = withTestDirTree $ do+  mapM_ (flip writeFile "") input+  result <- findHaskellFiles False input+  result @?= expected+  where+    input    = []+    expected = input