summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorMaxim Koltsov <kolmax94@gmail.com>2020-02-17 19:32:01 +0100
committerGitHub <noreply@github.com>2020-02-17 19:32:01 +0100
commitb8a731eb948b98019b8663c6fc653d2c930df2b1 (patch)
treeac2b95867755910564075caac605636e9babcaf7
parentab85690eb35dec46c8eb80a930337249f34b9f80 (diff)
downloadstylish-haskell-b8a731eb948b98019b8663c6fc653d2c930df2b1.tar.gz
Introduce nicer style for records (#266)
-rw-r--r--README.markdown56
-rw-r--r--data/stylish-haskell.yaml32
-rw-r--r--lib/Language/Haskell/Stylish/Config.hs25
-rw-r--r--lib/Language/Haskell/Stylish/Step/Data.hs88
-rw-r--r--stylish-haskell.cabal2
-rw-r--r--tests/Language/Haskell/Stylish/Config/Tests.hs7
-rw-r--r--tests/Language/Haskell/Stylish/Step/Data/Tests.hs311
-rw-r--r--tests/Language/Haskell/Stylish/Tests.hs67
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