From 7f1ac294012354042ecdb3820d54a5af164398ef Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Sat, 1 Feb 2020 12:37:15 +0300 Subject: [PATCH 1/5] Introduce nicer style for records This will format records like this: module Herp where data Foo a = Foo { a :: Int , a2 :: String -- ^ some haddock } | Bar { b :: a } deriving (Eq, Show) deriving (ToJSON) via Bar Foo Goals of this change are: - Achieve uniform style for data with one and many constructors by always starting the first constructor on the new line and aligning `=` and `|` symbols; - Visually separate fields from constructor names; - Keep a column with `{`, `,`, `}` clean by indenting line comments two spaces to the right. --- lib/Language/Haskell/Stylish/Step/Data.hs | 15 +- .../Haskell/Stylish/Step/Data/Tests.hs | 148 ++++++++++-------- 2 files changed, 92 insertions(+), 71 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 681c7c8c..d3412f49 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -54,11 +54,11 @@ changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead (H.QualConDecl _ _ _ (H.RecDecl {})) -> True _ -> False) decls - newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] + newLines = [[typeConstructor]] ++ fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] zipped = zip decls ([1..] ::[Int]) - constructors (decl, 1) = processConstructor allComments typeConstructor indentSize decl + constructors (decl, 1) = processConstructor allComments (indented "= ") indentSize decl constructors (decl, _) = processConstructor allComments (indented "| ") indentSize decl - typeConstructor = "data " <> H.prettyPrint dhead <> " = " + typeConstructor = "data " <> H.prettyPrint dhead indented = indent indentSize changeDecl _ _ _ = Nothing @@ -73,8 +73,13 @@ processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ addLineComment (Just (Comment _ _ c)) = " --" <> c addLineComment Nothing = "" addCommentBelow Nothing = [] - addCommentBelow (Just (Comment _ _ c)) = [indented "--" <> c] + addCommentBelow (Just (Comment _ _ c)) = [indentedComment "--" <> c] extractField (H.FieldDecl lb names _type) = (names, _type, findCommentOnLine lb allComments, findCommentBelowLine lb allComments) - indented = indent indentSize + + -- Skip indentSize from line start, then skip 2 spaces ("= " or "| ") to align with constructor name, + -- then skip indentSize again. + indented = indent $ indentSize + 2 + indentSize + -- Skip two more spaces from above ("{ " or ", ") to align with field name. + indentedComment = indent $ indentSize + 2 + indentSize + 2 processConstructor _ init _ decl = [init <> trimLeft (H.prettyPrint decl)] diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index ff5ca3be..e9134415 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -56,9 +56,10 @@ case01 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" ] case02 :: Assertion @@ -72,10 +73,11 @@ case02 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " , a2 :: String" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " }" ] case03 :: Assertion @@ -89,10 +91,11 @@ case03 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" ] case04 :: Assertion @@ -106,13 +109,14 @@ case04 = expected @=? testStep (step 2) input 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 @@ -129,10 +133,11 @@ case05 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " , a2 :: String" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " }" ] case06 :: Assertion @@ -176,14 +181,15 @@ case09 = expected @=? testStep (step 4) input 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 @@ -198,9 +204,10 @@ case10 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" , " deriving (Eq, Generic)" , " deriving (Show)" ] @@ -219,9 +226,10 @@ case11 = expected @=? testStep (step 2) input [ "{-# LANGUAGE DerivingStrategies #-}" , "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" , " deriving stock (Show)" ] @@ -237,10 +245,11 @@ case12 = expected @=? testStep (step 4) input expected = unlines [ "module Herp where" , "" - , "data Point = Point" - , " { pointX, pointY :: Double" - , " , pointName :: String" - , " }" + , "data Point" + , " = Point" + , " { pointX, pointY :: Double" + , " , pointName :: String" + , " }" , " deriving (Show)" ] @@ -257,9 +266,10 @@ case13 = expected @=? testStep (step 2) input [ "module Herp where" , "" , "-- this is a comment" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" ] case14 :: Assertion @@ -277,9 +287,10 @@ case14 = expected @=? testStep (step 2) input , "" , "{- this is" , " a comment -}" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" ] case15 :: Assertion @@ -296,10 +307,11 @@ case15 = expected @=? testStep (step 2) input 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 @@ -315,9 +327,10 @@ case16 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int -- ^ comment" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int -- ^ comment" + , " }" ] case17 :: Assertion @@ -335,11 +348,12 @@ case17 = expected @=? testStep (step 2) input 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 @@ -357,11 +371,12 @@ case18 = expected @=? testStep (step 2) input 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 @@ -379,11 +394,12 @@ case19 = expected @=? testStep (step 2) input 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) formating From e8c926b43e8cca14107faa6291cf81579e7bff3c Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Mon, 3 Feb 2020 01:01:56 +0300 Subject: [PATCH 2/5] WIP configurable record formatting --- lib/Language/Haskell/Stylish/Config.hs | 23 +++++- lib/Language/Haskell/Stylish/Step/Data.hs | 91 ++++++++++++++++------- stylish-haskell.cabal | 2 + 3 files changed, 89 insertions(+), 27 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index ba9cb313..c7d47873 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -24,12 +24,14 @@ import Data.List (intercalate, 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) -------------------------------------------------------------------------------- @@ -186,8 +188,25 @@ parseSimpleAlign c o = SimpleAlign.step -------------------------------------------------------------------------------- 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 -------------------------------------------------------------------------------- diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index d3412f49..2a8e211c 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -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.Step 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 0) + , 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,9 +61,9 @@ commentsWithin lb = filter within 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) +changeDecl allComments cfg@Config{..} (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) | hasRecordFields = Just $ change block (const $ concat newLines) | otherwise = Nothing where @@ -54,32 +72,55 @@ changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead (H.QualConDecl _ _ _ (H.RecDecl {})) -> True _ -> False) decls - newLines = [[typeConstructor]] ++ fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] - zipped = zip decls ([1..] ::[Int]) - constructors (decl, 1) = processConstructor allComments (indented "= ") indentSize decl - constructors (decl, _) = processConstructor allComments (indented "| ") indentSize decl + typeConstructor = "data " <> H.prettyPrint dhead - indented = indent indentSize + + -- 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 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 n "{ " + , 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)) = [indentedComment "--" <> c] + addCommentBelow (Just (Comment _ _ c)) = [indent (fieldIndent + cFieldComment) "--" <> c] + extractField (H.FieldDecl lb names _type) = (names, _type, findCommentOnLine lb allComments, findCommentBelowLine lb allComments) - -- Skip indentSize from line start, then skip 2 spaces ("= " or "| ") to align with constructor name, - -- then skip indentSize again. - indented = indent $ indentSize + 2 + indentSize - -- Skip two more spaces from above ("{ " or ", ") to align with field name. - indentedComment = indent $ indentSize + 2 + indentSize + 2 processConstructor _ init _ decl = [init <> trimLeft (H.prettyPrint decl)] diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index b3f29753..6bad961d 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -64,6 +64,7 @@ Library 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 @@ Test-suite stylish-haskell-tests 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 From ee13e4af6ca48aaad17539fa12f908b8490bedfd Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Mon, 3 Feb 2020 01:10:51 +0300 Subject: [PATCH 3/5] Measure `{` indent from constructor name --- lib/Language/Haskell/Stylish/Step/Data.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 2a8e211c..1f7732be 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -21,7 +21,7 @@ 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 0) + -- ^ 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 @@ -105,8 +105,8 @@ processConstructor allComments init Config{..} (H.QualConDecl _ _ _ (H.RecDecl _ ) Indent n -> ( Just [init <> H.prettyPrint dname] - , indent n "{ " - , n + , indent (length init + n) "{ " + , length init + n ) processName prefix (fnames, _type, lineComment, commentBelowLine) = From c5120806abe5ad22e2507fae9f9b295609dc6060 Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Fri, 7 Feb 2020 22:21:08 +0300 Subject: [PATCH 4/5] Document new record formatting --- README.markdown | 56 ++++++++++++++++++++++++++ data/stylish-haskell.yaml | 32 ++++++++++++--- lib/Language/Haskell/Stylish/Config.hs | 2 - 3 files changed, 83 insertions(+), 7 deletions(-) diff --git a/README.markdown b/README.markdown index 54451ccd..e4204176 100644 --- a/README.markdown +++ b/README.markdown @@ -33,6 +33,7 @@ You can also install it using your package manager: - 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. @@ -102,6 +103,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 Since it works as a filter it is pretty easy to integrate this with VIM. diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 209d6131..d7de2606 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -15,8 +15,33 @@ steps: # # 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 @@ -225,9 +250,6 @@ steps: # 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. # diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index c7d47873..475a5e36 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -56,7 +56,6 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config { configSteps :: [Step] - , configIndent :: Int , configColumns :: Maybe Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline @@ -123,7 +122,6 @@ parseConfig (A.Object o) = do -- 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) From f76b6f644cc47501840742b4fae71f04b2061b3a Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Fri, 7 Feb 2020 22:48:32 +0300 Subject: [PATCH 5/5] Update tests --- .../Language/Haskell/Stylish/Config/Tests.hs | 7 +- .../Haskell/Stylish/Step/Data/Tests.hs | 163 +++++++++++++++--- tests/Language/Haskell/Stylish/Tests.hs | 53 ++++-- 3 files changed, 187 insertions(+), 36 deletions(-) diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index 464ebb79..a8b2ee28 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -148,8 +148,11 @@ dotStylish = unlines $ , " 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" diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index e9134415..1e7f2549 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -31,10 +31,14 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , 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" @@ -45,7 +49,7 @@ case00 = expected @=? testStep (step 2) input expected = input case01 :: Assertion -case01 = expected @=? testStep (step 2) input +case01 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -63,7 +67,7 @@ case01 = expected @=? testStep (step 2) input ] case02 :: Assertion -case02 = expected @=? testStep (step 2) input +case02 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -81,7 +85,7 @@ case02 = expected @=? testStep (step 2) input ] case03 :: Assertion -case03 = expected @=? testStep (step 2) input +case03 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -99,7 +103,7 @@ case03 = expected @=? testStep (step 2) input ] case04 :: Assertion -case04 = expected @=? testStep (step 2) input +case04 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -120,7 +124,7 @@ case04 = expected @=? testStep (step 2) input ] case05 :: Assertion -case05 = expected @=? testStep (step 2) input +case05 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -141,7 +145,7 @@ case05 = expected @=? testStep (step 2) input ] case06 :: Assertion -case06 = expected @=? testStep (step 2) input +case06 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -151,7 +155,7 @@ case06 = expected @=? testStep (step 2) input expected = input case07 :: Assertion -case07 = expected @=? testStep (step 2) input +case07 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -161,7 +165,7 @@ case07 = expected @=? testStep (step 2) input expected = input case08 :: Assertion -case08 = input @=? testStep (step 2) input +case08 = input @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -171,7 +175,7 @@ case08 = input @=? testStep (step 2) input ] case09 :: Assertion -case09 = expected @=? testStep (step 4) input +case09 = expected @=? testStep (step indentIndentStyle4) input where input = unlines [ "module Herp where" @@ -193,7 +197,7 @@ case09 = expected @=? testStep (step 4) input ] case10 :: Assertion -case10 = expected @=? testStep (step 2) input +case10 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -213,7 +217,7 @@ case10 = expected @=? testStep (step 2) input ] case11 :: Assertion -case11 = expected @=? testStep (step 2) input +case11 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "{-# LANGUAGE DerivingStrategies #-}" @@ -234,7 +238,7 @@ case11 = expected @=? testStep (step 2) input ] case12 :: Assertion -case12 = expected @=? testStep (step 4) input +case12 = expected @=? testStep (step indentIndentStyle4) input where input = unlines [ "module Herp where" @@ -254,7 +258,7 @@ case12 = expected @=? testStep (step 4) input ] case13 :: Assertion -case13 = expected @=? testStep (step 2) input +case13 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -273,7 +277,7 @@ case13 = expected @=? testStep (step 2) input ] case14 :: Assertion -case14 = expected @=? testStep (step 2) input +case14 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -294,7 +298,7 @@ case14 = expected @=? testStep (step 2) input ] case15 :: Assertion -case15 = expected @=? testStep (step 2) input +case15 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -315,7 +319,7 @@ case15 = expected @=? testStep (step 2) input ] case16 :: Assertion -case16 = expected @=? testStep (step 2) input +case16 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -334,7 +338,7 @@ case16 = expected @=? testStep (step 2) input ] case17 :: Assertion -case17 = expected @=? testStep (step 2) input +case17 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -357,7 +361,7 @@ case17 = expected @=? testStep (step 2) input ] case18 :: Assertion -case18 = expected @=? testStep (step 2) input +case18 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -380,7 +384,7 @@ case18 = expected @=? testStep (step 2) input ] case19 :: Assertion -case19 = expected @=? testStep (step 2) input +case19 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -406,10 +410,127 @@ case19 = expected @=? testStep (step 2) input -- -- See https://github.com/jaspervdj/stylish-haskell/issues/262 case20 :: Assertion -case20 = input @=? testStep (step 2) input +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 diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs index 59ca92bf..9c24180c 100644 --- a/tests/Language/Haskell/Stylish/Tests.hs +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -21,6 +21,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Tabs.Tests" [ testCase "case 01" case01 , testCase "case 02" case02 , testCase "case 03" case03 + , testCase "case 04" case04 ] @@ -29,12 +30,7 @@ case01 :: Assertion case01 = (@?= result) =<< format Nothing Nothing input where input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" - result = Right [ "module Herp where" - , "data Foo = Bar" - , " | Baz" - , " { baz :: Int" - , " }" - ] + result = Right $ lines input -------------------------------------------------------------------------------- @@ -42,8 +38,11 @@ case02 :: Assertion 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 @@ -51,16 +50,44 @@ case02 = withTestDirTree $ do where input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" result = Right [ "module Herp where" - , "data Foo = Bar" + , "data Foo" + , " = Bar" , " | Baz" - , " { baz :: Int" - , " }" + , " { 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"