diff options
author | Maxim Koltsov <kolmax94@gmail.com> | 2020-02-17 19:32:01 +0100 |
---|---|---|
committer | GitHub <noreply@github.com> | 2020-02-17 19:32:01 +0100 |
commit | b8a731eb948b98019b8663c6fc653d2c930df2b1 (patch) | |
tree | ac2b95867755910564075caac605636e9babcaf7 | |
parent | ab85690eb35dec46c8eb80a930337249f34b9f80 (diff) | |
download | stylish-haskell-b8a731eb948b98019b8663c6fc653d2c930df2b1.tar.gz |
Introduce nicer style for records (#266)
-rw-r--r-- | README.markdown | 56 | ||||
-rw-r--r-- | data/stylish-haskell.yaml | 32 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Config.hs | 25 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/Data.hs | 88 | ||||
-rw-r--r-- | stylish-haskell.cabal | 2 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Config/Tests.hs | 7 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 311 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Tests.hs | 67 |
8 files changed, 449 insertions, 139 deletions
diff --git a/README.markdown b/README.markdown index 54451cc..e420417 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 209d613..d7de260 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 ba9cb31..475a5e3 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) -------------------------------------------------------------------------------- @@ -54,7 +56,6 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config { configSteps :: [Step] - , configIndent :: Int , configColumns :: Maybe Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline @@ -121,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) @@ -186,8 +186,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 681c7c8..1f7732b 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 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,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,27 +72,55 @@ 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] + + 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)] diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index b3f2975..6bad961 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 diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index 464ebb7..a8b2ee2 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 ff5ca3b..1e7f254 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" @@ -56,13 +60,14 @@ case01 = expected @=? testStep (step 2) input 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" @@ -72,14 +77,15 @@ 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 -case03 = expected @=? testStep (step 2) input +case03 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -89,14 +95,15 @@ 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 -case04 = expected @=? testStep (step 2) input +case04 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -106,17 +113,18 @@ 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 -case05 = expected @=? testStep (step 2) input +case05 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -129,14 +137,15 @@ 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 -case06 = expected @=? testStep (step 2) input +case06 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -146,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" @@ -156,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" @@ -166,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" @@ -176,18 +185,19 @@ 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 -case10 = expected @=? testStep (step 2) input +case10 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -198,15 +208,16 @@ 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)" ] case11 :: Assertion -case11 = expected @=? testStep (step 2) input +case11 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "{-# LANGUAGE DerivingStrategies #-}" @@ -219,14 +230,15 @@ case11 = expected @=? testStep (step 2) input [ "{-# 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" @@ -237,15 +249,16 @@ 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)" ] case13 :: Assertion -case13 = expected @=? testStep (step 2) input +case13 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -257,13 +270,14 @@ 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 -case14 = expected @=? testStep (step 2) input +case14 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -277,13 +291,14 @@ case14 = expected @=? testStep (step 2) input , "" , "{- 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" @@ -296,14 +311,15 @@ 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 -case16 = expected @=? testStep (step 2) input +case16 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -315,13 +331,14 @@ 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 -case17 = expected @=? testStep (step 2) input +case17 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -335,15 +352,16 @@ 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 -case18 = expected @=? testStep (step 2) input +case18 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -357,15 +375,16 @@ 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 -case19 = expected @=? testStep (step 2) input +case19 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -379,21 +398,139 @@ 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 -- -- 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 e7faa9b..97eab8a 100644 --- a/tests/Language/Haskell/Stylish/Tests.hs +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -20,13 +20,14 @@ import Language.Haskell.Stylish.Tests.Util -------------------------------------------------------------------------------- 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 ] @@ -35,12 +36,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 -------------------------------------------------------------------------------- @@ -48,8 +44,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 @@ -57,16 +56,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" @@ -78,8 +105,8 @@ case03 = (@?= result) =<< format Nothing (Just fileLocation) input -------------------------------------------------------------------------------- -- | When providing current dir including folders and files. -case04 :: Assertion -case04 = withTestDirTree $ do +case05 :: Assertion +case05 = withTestDirTree $ do createDirectory aDir >> writeFile c fileCont mapM_ (flip writeFile fileCont) fs result <- findHaskellFiles False input @@ -95,8 +122,8 @@ case04 = withTestDirTree $ do -------------------------------------------------------------------------------- -- | When the input item is not file, do not recurse it. -case05 :: Assertion -case05 = withTestDirTree $ do +case06 :: Assertion +case06 = withTestDirTree $ do mapM_ (flip writeFile "") input result <- findHaskellFiles False input result @?= expected @@ -107,8 +134,8 @@ case05 = withTestDirTree $ do -------------------------------------------------------------------------------- -- | Empty input should result in empty output. -case06 :: Assertion -case06 = withTestDirTree $ do +case07 :: Assertion +case07 = withTestDirTree $ do mapM_ (flip writeFile "") input result <- findHaskellFiles False input result @?= expected |