From 0c9054d3c8e3776ff3abde221fa3c9c34a666231 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Szulc?= Date: Thu, 16 Jan 2020 11:56:59 +0100 Subject: [PATCH 01/36] Initial test describing simplest scenario for Data step MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- lib/Language/Haskell/Stylish/Step/Data.hs | 6 ++++ stylish-haskell.cabal | 3 ++ .../Haskell/Stylish/Step/Data/Tests.hs | 31 +++++++++++++++++++ tests/TestSuite.hs | 2 ++ 4 files changed, 42 insertions(+) create mode 100644 lib/Language/Haskell/Stylish/Step/Data.hs create mode 100644 tests/Language/Haskell/Stylish/Step/Data/Tests.hs diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs new file mode 100644 index 00000000..fb9d136c --- /dev/null +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -0,0 +1,6 @@ +module Language.Haskell.Stylish.Step.Data where + +import Language.Haskell.Stylish.Step + +step :: Step +step = makeStep "Data" const diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 116d8892..de12c112 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -29,6 +29,7 @@ Library Exposed-modules: Language.Haskell.Stylish + Language.Haskell.Stylish.Step.Data Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.LanguagePragmas Language.Haskell.Stylish.Step.SimpleAlign @@ -107,6 +108,8 @@ Test-suite stylish-haskell-tests Language.Haskell.Stylish.Step Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.Imports.Tests + Language.Haskell.Stylish.Step.Data + Language.Haskell.Stylish.Step.Data.Tests Language.Haskell.Stylish.Step.LanguagePragmas Language.Haskell.Stylish.Step.LanguagePragmas.Tests Language.Haskell.Stylish.Step.SimpleAlign diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs new file mode 100644 index 00000000..23436c52 --- /dev/null +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -0,0 +1,31 @@ +module Language.Haskell.Stylish.Step.Data.Tests + ( tests + ) where + +import Language.Haskell.Stylish.Step.Data +import Language.Haskell.Stylish.Tests.Util (testStep) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, (@=?)) + +tests :: Test +tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" + [ testCase "case 01" case01] + +simpleInput :: String +simpleInput = unlines + [ "module Herp where" + , "" + , "data Foo = Foo { a :: Int }" + ] + +case01 :: Assertion +case01 = expected @=? testStep step simpleInput + where + expected = unlines + [ "module Herp where" + , "" + , "data Foo = Foo" + , " { a :: Int" + , " }" + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index b5bec904..a6f51ea4 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -11,6 +11,7 @@ import Test.Framework (default -------------------------------------------------------------------------------- import qualified Language.Haskell.Stylish.Config.Tests import qualified Language.Haskell.Stylish.Parse.Tests +import qualified Language.Haskell.Stylish.Step.Data.Tests import qualified Language.Haskell.Stylish.Step.Imports.Tests import qualified Language.Haskell.Stylish.Step.LanguagePragmas.Tests import qualified Language.Haskell.Stylish.Step.SimpleAlign.Tests @@ -25,6 +26,7 @@ main :: IO () main = defaultMain [ Language.Haskell.Stylish.Parse.Tests.tests , Language.Haskell.Stylish.Config.Tests.tests + , Language.Haskell.Stylish.Step.Data.Tests.tests , Language.Haskell.Stylish.Step.Imports.Tests.tests , Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests , Language.Haskell.Stylish.Step.SimpleAlign.Tests.tests From 43718c19c4e03dd8f3c390ca481504eb49c91cbf Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Thu, 16 Jan 2020 13:07:04 +0100 Subject: [PATCH 02/36] [sanity-check] Delete data defs --- lib/Language/Haskell/Stylish/Step/Data.hs | 24 ++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index fb9d136c..60c67c4c 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,6 +1,28 @@ module Language.Haskell.Stylish.Step.Data where +import qualified Language.Haskell.Exts as H +import qualified Language.Haskell.Exts.Syntax as H + +import Language.Haskell.Stylish.Block +import Language.Haskell.Stylish.Editor import Language.Haskell.Stylish.Step +import Language.Haskell.Stylish.Util + +datas :: H.Module l -> [(l, H.Decl l)] +datas modu = + [ (l, H.DataDecl l b c d e f) + | H.Module _ _ _ _ decls <- [modu] + , H.DataDecl l b c d e f <- decls + ] + step :: Step -step = makeStep "Data" const +step = makeStep "Data" step' + +step' :: Lines -> Module -> Lines +step' ls (module', _) = applyChanges changes ls + where + datas' = datas $ fmap linesFromSrcSpan module' + changes = fmap (delete . fst) datas' + +prettyDataDecls = undefined From 88a5b8642172eab0284aabaeeb0cec05fe29189b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Szulc?= Date: Thu, 16 Jan 2020 14:57:58 +0100 Subject: [PATCH 03/36] Extract changeDecl MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- lib/Language/Haskell/Stylish/Step/Data.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 60c67c4c..1d6411f1 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,12 +1,10 @@ module Language.Haskell.Stylish.Step.Data where import qualified Language.Haskell.Exts as H -import qualified Language.Haskell.Exts.Syntax as H import Language.Haskell.Stylish.Block import Language.Haskell.Stylish.Editor import Language.Haskell.Stylish.Step -import Language.Haskell.Stylish.Util datas :: H.Module l -> [(l, H.Decl l)] datas modu = @@ -15,6 +13,7 @@ datas modu = , H.DataDecl l b c d e f <- decls ] +type ChangeLine = Change String step :: Step step = makeStep "Data" step' @@ -23,6 +22,7 @@ step' :: Lines -> Module -> Lines step' ls (module', _) = applyChanges changes ls where datas' = datas $ fmap linesFromSrcSpan module' - changes = fmap (delete . fst) datas' + changes = datas' >>= changeDecl -prettyDataDecls = undefined +changeDecl :: (LineBlock, H.Decl l) -> [ChangeLine] +changeDecl (block, _) = [change block ("-- this is a comment" : )] From 467a18376125240b4651974347d1daf435695da2 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Thu, 16 Jan 2020 15:50:29 +0100 Subject: [PATCH 04/36] First green test :-) --- lib/Language/Haskell/Stylish/Step/Data.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 1d6411f1..8fd19f6f 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -25,4 +25,14 @@ step' ls (module', _) = applyChanges changes ls changes = datas' >>= changeDecl changeDecl :: (LineBlock, H.Decl l) -> [ChangeLine] -changeDecl (block, _) = [change block ("-- this is a comment" : )] +changeDecl (block, H.DataDecl _ (H.DataType _) _ (H.DHead _ ident) qualConDecls _) = do + (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) <- qualConDecls + (H.FieldDecl _ names _type) <- fields + fname <- names + [change block (\_ -> + ["data " <> H.prettyPrint ident <> " = " <> H.prettyPrint dname + ," { " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type + ," }" + ] + )] +changeDecl _ = [] From fd44a32c0c80c6bc3721788a63c443ae3e4fb6dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Szulc?= Date: Thu, 16 Jan 2020 17:26:06 +0100 Subject: [PATCH 05/36] Cover case where there are more then one field in data type declaration MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- lib/Language/Haskell/Stylish/Step/Data.hs | 26 +++++++------- .../Haskell/Stylish/Step/Data/Tests.hs | 36 ++++++++++++++----- 2 files changed, 39 insertions(+), 23 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 8fd19f6f..d280a060 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,7 +1,7 @@ module Language.Haskell.Stylish.Step.Data where +import Data.Maybe (maybeToList) import qualified Language.Haskell.Exts as H - import Language.Haskell.Stylish.Block import Language.Haskell.Stylish.Editor import Language.Haskell.Stylish.Step @@ -22,17 +22,15 @@ step' :: Lines -> Module -> Lines step' ls (module', _) = applyChanges changes ls where datas' = datas $ fmap linesFromSrcSpan module' - changes = datas' >>= changeDecl + changes = datas' >>= (maybeToList . changeDecl) -changeDecl :: (LineBlock, H.Decl l) -> [ChangeLine] -changeDecl (block, H.DataDecl _ (H.DataType _) _ (H.DHead _ ident) qualConDecls _) = do - (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) <- qualConDecls - (H.FieldDecl _ names _type) <- fields - fname <- names - [change block (\_ -> - ["data " <> H.prettyPrint ident <> " = " <> H.prettyPrint dname - ," { " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type - ," }" - ] - )] -changeDecl _ = [] +changeDecl :: (LineBlock, H.Decl l) -> Maybe ChangeLine +changeDecl (block, H.DataDecl _ (H.DataType _) _ (H.DHead _ ident) [(H.QualConDecl _ _ _ (H.RecDecl _ dname fields))] _) = + Just $ change block (const newLines) + where + newLines = typeConstructor : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [" }"] + typeConstructor = "data " <> H.prettyPrint ident <> " = " <> H.prettyPrint dname + firstName (fname, _type) = " { " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type + otherName (fname, _type) = " , " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type + extractField (H.FieldDecl _ names _type) = (head names, _type) +changeDecl _ = Nothing diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 23436c52..ea3a37cd 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -10,22 +10,40 @@ import Test.HUnit (Assertion, (@=?)) tests :: Test tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" - [ testCase "case 01" case01] - -simpleInput :: String -simpleInput = unlines - [ "module Herp where" - , "" - , "data Foo = Foo { a :: Int }" - ] + [ testCase "case 01" case01 + , testCase "case 02" case02 + ] case01 :: Assertion -case01 = expected @=? testStep step simpleInput +case01 = expected @=? testStep step input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo { a :: Int }" + ] + + expected = unlines + [ "module Herp where" + , "" + , "data Foo = Foo" + , " { a :: Int" + , " }" + ] + +case02 :: Assertion +case02 = expected @=? testStep step input where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo { a :: Int, a2 :: String }" + ] expected = unlines [ "module Herp where" , "" , "data Foo = Foo" , " { a :: Int" + , " , a2 :: String" , " }" ] From cdc0fbbabcf40ac8f80d3d97ab7dd49b11a19743 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Thu, 16 Jan 2020 18:17:04 +0100 Subject: [PATCH 06/36] Add case03 where a type variable is present --- lib/Language/Haskell/Stylish/Step/Data.hs | 4 ++-- .../Haskell/Stylish/Step/Data/Tests.hs | 18 ++++++++++++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index d280a060..6a4ce3c6 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -25,11 +25,11 @@ step' ls (module', _) = applyChanges changes ls changes = datas' >>= (maybeToList . changeDecl) changeDecl :: (LineBlock, H.Decl l) -> Maybe ChangeLine -changeDecl (block, H.DataDecl _ (H.DataType _) _ (H.DHead _ ident) [(H.QualConDecl _ _ _ (H.RecDecl _ dname fields))] _) = +changeDecl (block, H.DataDecl _ (H.DataType _) _ dhead [(H.QualConDecl _ _ _ (H.RecDecl _ dname fields))] _) = Just $ change block (const newLines) where newLines = typeConstructor : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [" }"] - typeConstructor = "data " <> H.prettyPrint ident <> " = " <> H.prettyPrint dname + typeConstructor = "data " <> H.prettyPrint dhead <> " = " <> H.prettyPrint dname firstName (fname, _type) = " { " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type otherName (fname, _type) = " , " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type extractField (H.FieldDecl _ names _type) = (head names, _type) diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index ea3a37cd..c94e52b6 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -12,6 +12,7 @@ tests :: Test tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" [ testCase "case 01" case01 , testCase "case 02" case02 + , testCase "case 03" case03 ] case01 :: Assertion @@ -47,3 +48,20 @@ case02 = expected @=? testStep step input , " , a2 :: String" , " }" ] + +case03 :: Assertion +case03 = expected @=? testStep step input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo { a :: a, a2 :: String }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" + ] From 1849ed35536e5056c56aa08e93f6591aea1410bf Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Thu, 16 Jan 2020 18:19:33 +0100 Subject: [PATCH 07/36] Add case04 - multiple declarations --- .../Haskell/Stylish/Step/Data/Tests.hs | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index c94e52b6..38aabe81 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -13,6 +13,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" [ testCase "case 01" case01 , testCase "case 02" case02 , testCase "case 03" case03 + , testCase "case 04" case04 ] case01 :: Assertion @@ -65,3 +66,23 @@ case03 = expected @=? testStep step input , " , a2 :: String" , " }" ] + +case04 :: Assertion +case04 = expected @=? testStep step input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo { a :: a, a2 :: String } | Bar { b :: a }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" + , " | Bar" + , " { b :: a" + , " }" + ] From e21d226a261fcdbe44aa0d9f2d26ae0fa2269a38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=81ukasz=20Go=C5=82=C4=99biewski?= Date: Thu, 16 Jan 2020 22:51:45 +0100 Subject: [PATCH 08/36] Make case04 pass --- lib/Language/Haskell/Stylish/Step/Data.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 6a4ce3c6..c2fb6a74 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -25,12 +25,18 @@ step' ls (module', _) = applyChanges changes ls changes = datas' >>= (maybeToList . changeDecl) changeDecl :: (LineBlock, H.Decl l) -> Maybe ChangeLine -changeDecl (block, H.DataDecl _ (H.DataType _) _ dhead [(H.QualConDecl _ _ _ (H.RecDecl _ dname fields))] _) = - Just $ change block (const newLines) +changeDecl (block, H.DataDecl _ (H.DataType _) _ dhead decls _) = + Just $ change block (const $ concat newLines) where - newLines = typeConstructor : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [" }"] - typeConstructor = "data " <> H.prettyPrint dhead <> " = " <> H.prettyPrint dname + zipped = zip decls [1..] + newLines = fmap (\(decl, i) -> if (i == 1) then processConstructor typeConstructor decl else processConstructor " | " decl) zipped + typeConstructor = "data " <> H.prettyPrint dhead <> " = " firstName (fname, _type) = " { " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type otherName (fname, _type) = " , " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type extractField (H.FieldDecl _ names _type) = (head names, _type) + + processConstructor init (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do + init <> H.prettyPrint dname : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [" }"] + processConstructor _ _ = [] + changeDecl _ = Nothing From df4ccd6fdf809c8bcaadaeb7b3ad664c7830567c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Szulc?= Date: Fri, 17 Jan 2020 09:37:44 +0100 Subject: [PATCH 09/36] Extend tests with case05 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- .../Haskell/Stylish/Step/Data/Tests.hs | 22 +++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 38aabe81..2682f4c1 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -14,6 +14,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 02" case02 , testCase "case 03" case03 , testCase "case 04" case04 + , testCase "case 05" case05 ] case01 :: Assertion @@ -86,3 +87,24 @@ case04 = expected @=? testStep step input , " { b :: a" , " }" ] + +case05 :: Assertion +case05 = expected @=? testStep step input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo {" + , " a :: Int" + , " , a2 :: String" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo = Foo" + , " { a :: Int" + , " , a2 :: String" + , " }" + ] + From 4577f7abe1f0644dbd889ee77b6c507accf03f44 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Szulc?= Date: Fri, 17 Jan 2020 09:47:47 +0100 Subject: [PATCH 10/36] Add pending case06 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 2682f4c1..ec2345f3 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -15,6 +15,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 03" case03 , testCase "case 04" case04 , testCase "case 05" case05 +-- , testCase "case 06" case06 ] case01 :: Assertion @@ -108,3 +109,12 @@ case05 = expected @=? testStep step input , " }" ] +case06 :: Assertion +case06 = expected @=? testStep step input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo Int String" + ] + expected = input From aa1ab20c7be34c8d998b40d060f7d622b7ff6fcc Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 09:54:43 +0100 Subject: [PATCH 11/36] Fix case 06 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- lib/Language/Haskell/Stylish/Step/Data.hs | 3 ++- tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index c2fb6a74..0d5505a7 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -5,6 +5,7 @@ import qualified Language.Haskell.Exts as H import Language.Haskell.Stylish.Block import Language.Haskell.Stylish.Editor import Language.Haskell.Stylish.Step +import Language.Haskell.Stylish.Util datas :: H.Module l -> [(l, H.Decl l)] datas modu = @@ -37,6 +38,6 @@ changeDecl (block, H.DataDecl _ (H.DataType _) _ dhead decls _) = processConstructor init (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do init <> H.prettyPrint dname : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [" }"] - processConstructor _ _ = [] + processConstructor init decl = [init <> trimLeft (H.prettyPrint decl)] changeDecl _ = Nothing diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index ec2345f3..efd6b753 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -15,7 +15,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 03" case03 , testCase "case 04" case04 , testCase "case 05" case05 --- , testCase "case 06" case06 + , testCase "case 06" case06 ] case01 :: Assertion From 67436d67a78e51699a8e5d505b3145873c6b82d1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pawe=C5=82=20Szulc?= Date: Fri, 17 Jan 2020 09:56:06 +0100 Subject: [PATCH 12/36] Add case07 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index efd6b753..b8ffb1d2 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -16,6 +16,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 04" case04 , testCase "case 05" case05 , testCase "case 06" case06 + , testCase "case 07" case07 ] case01 :: Assertion @@ -118,3 +119,13 @@ case06 = expected @=? testStep step input , "data Foo = Foo Int String" ] expected = input + +case07 :: Assertion +case07 = expected @=? testStep step input + where + input = unlines + [ "module Herp where" + , "" + , "data Phantom a = Phantom" + ] + expected = input From 44632670fb240cb43f5ee4ac23ef1ab19cae4405 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 09:59:35 +0100 Subject: [PATCH 13/36] Add second phantom case --- .../Language/Haskell/Stylish/Step/Data/Tests.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index b8ffb1d2..c8baa22c 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -17,6 +17,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 05" case05 , testCase "case 06" case06 , testCase "case 07" case07 + , testCase "case 08" case08 ] case01 :: Assertion @@ -129,3 +130,18 @@ case07 = expected @=? testStep step input , "data Phantom a = Phantom" ] expected = input + +case08 :: Assertion +case08 = expected @=? testStep step input + where + input = unlines + [ "module Herp where" + , "" + , "data Phantom a =" + , " Phantom" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Phantom a = Phantom" + ] From 60125ce66bb94914be3399a95017e80c23478dd4 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 10:52:18 +0100 Subject: [PATCH 14/36] Add records to config --- data/stylish-haskell.yaml | 1 + lib/Language/Haskell/Stylish.hs | 5 +++++ lib/Language/Haskell/Stylish/Config.hs | 6 ++++++ tests/Language/Haskell/Stylish/Config/Tests.hs | 1 + 4 files changed, 13 insertions(+) diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 2a17cb5d..0e9cced5 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -221,6 +221,7 @@ steps: # elements into single spaces. Basically, this undoes the effect of # simple_align but is a bit less conservative. # - squash: {} + - records: {} # 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.hs b/lib/Language/Haskell/Stylish.hs index a40a7d2a..8c8bbcc0 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -29,6 +29,7 @@ import Control.Monad (foldM) import Language.Haskell.Stylish.Config import Language.Haskell.Stylish.Parse import Language.Haskell.Stylish.Step +import qualified Language.Haskell.Stylish.Step.Data as Data import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign @@ -39,6 +40,10 @@ import Language.Haskell.Stylish.Verbose import Paths_stylish_haskell (version) +-------------------------------------------------------------------------------- +records :: Step +records = Data.step + -------------------------------------------------------------------------------- simpleAlign :: Maybe Int -- ^ Columns -> SimpleAlign.Config diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 725a4655..0223147a 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -35,6 +35,7 @@ import qualified System.IO as IO (Newline import qualified Language.Haskell.Stylish.Config.Cabal as Cabal import Language.Haskell.Stylish.Config.Internal import Language.Haskell.Stylish.Step +import qualified Language.Haskell.Stylish.Step.Data as Data import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign @@ -141,6 +142,7 @@ parseConfig _ = mzero catalog :: Map String (Config -> A.Object -> A.Parser Step) catalog = M.fromList [ ("imports", parseImports) + , ("records", parseRecords) , ("language_pragmas", parseLanguagePragmas) , ("simple_align", parseSimpleAlign) , ("squash", parseSquash) @@ -180,6 +182,10 @@ parseSimpleAlign c o = SimpleAlign.step where withDef f k = fromMaybe (f SimpleAlign.defaultConfig) <$> (o A..:? k) +-------------------------------------------------------------------------------- +parseRecords :: Config -> A.Object -> A.Parser Step +parseRecords _ _ = return Data.step + -------------------------------------------------------------------------------- parseSquash :: Config -> A.Object -> A.Parser Step diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index ebaef543..c89077f3 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -165,6 +165,7 @@ dotStylish = unlines $ , " align: false" , " remove_redundant: true" , " - trailing_whitespace: {}" + , " - records: {}" , "columns: 110" , "language_extensions:" , " - TemplateHaskell" From 842d3d7f514a4b08cfb3b0ffad2f879c068e1107 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 11:25:36 +0100 Subject: [PATCH 15/36] Make indent size configurable for records MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Paweł Szulc --- data/stylish-haskell.yaml | 5 ++- lib/Language/Haskell/Stylish.hs | 1 - lib/Language/Haskell/Stylish/Config.hs | 3 +- lib/Language/Haskell/Stylish/Step/Data.hs | 25 ++++++------ .../Haskell/Stylish/Step/Data/Tests.hs | 38 +++++++++++++++---- 5 files changed, 49 insertions(+), 23 deletions(-) diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 0e9cced5..3fa21056 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -15,6 +15,10 @@ steps: # # true. # add_language_pragma: true + # Format record definitions + - records: + indent: 4 + # Align the right hand side of some elements. This is quite conservative # and only applies to statements where each element occupies a single # line. All default to true. @@ -221,7 +225,6 @@ steps: # elements into single spaces. Basically, this undoes the effect of # simple_align but is a bit less conservative. # - squash: {} - - records: {} # 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.hs b/lib/Language/Haskell/Stylish.hs index 8c8bbcc0..c39b63a2 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -29,7 +29,6 @@ import Control.Monad (foldM) import Language.Haskell.Stylish.Config import Language.Haskell.Stylish.Parse import Language.Haskell.Stylish.Step -import qualified Language.Haskell.Stylish.Step.Data as Data import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 0223147a..7b199ad6 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -184,7 +184,8 @@ parseSimpleAlign c o = SimpleAlign.step -------------------------------------------------------------------------------- parseRecords :: Config -> A.Object -> A.Parser Step -parseRecords _ _ = return Data.step +parseRecords _ o = Data.step + <$> (o A..:? "indent" A..!= 4) -------------------------------------------------------------------------------- diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 0d5505a7..2a60eb0c 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -16,28 +16,29 @@ datas modu = type ChangeLine = Change String -step :: Step -step = makeStep "Data" step' +step :: Int -> Step +step indent = makeStep "Data" (step' indent) -step' :: Lines -> Module -> Lines -step' ls (module', _) = applyChanges changes ls +step' :: Int -> Lines -> Module -> Lines +step' indent ls (module', _) = applyChanges changes ls where datas' = datas $ fmap linesFromSrcSpan module' - changes = datas' >>= (maybeToList . changeDecl) + changes = datas' >>= (maybeToList . (changeDecl indent)) -changeDecl :: (LineBlock, H.Decl l) -> Maybe ChangeLine -changeDecl (block, H.DataDecl _ (H.DataType _) _ dhead decls _) = +changeDecl :: Int -> (LineBlock, H.Decl l) -> Maybe ChangeLine +changeDecl indent (block, H.DataDecl _ (H.DataType _) _ dhead decls _) = Just $ change block (const $ concat newLines) where zipped = zip decls [1..] - newLines = fmap (\(decl, i) -> if (i == 1) then processConstructor typeConstructor decl else processConstructor " | " decl) zipped + newLines = fmap (\(decl, i) -> if (i == 1) then processConstructor typeConstructor decl else processConstructor (indented "| ") decl) zipped typeConstructor = "data " <> H.prettyPrint dhead <> " = " - firstName (fname, _type) = " { " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type - otherName (fname, _type) = " , " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type + firstName (fname, _type) = indented "{ " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type + otherName (fname, _type) = indented ", " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type extractField (H.FieldDecl _ names _type) = (head names, _type) processConstructor init (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do - init <> H.prettyPrint dname : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [" }"] + init <> H.prettyPrint dname : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [indented "}"] processConstructor init decl = [init <> trimLeft (H.prettyPrint decl)] -changeDecl _ = Nothing + indented str = (replicate indent ' ') <> str +changeDecl _ _ = Nothing diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index c8baa22c..22e40652 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -18,10 +18,11 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 06" case06 , testCase "case 07" case07 , testCase "case 08" case08 + , testCase "case 09" case09 ] case01 :: Assertion -case01 = expected @=? testStep step input +case01 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" @@ -38,7 +39,7 @@ case01 = expected @=? testStep step input ] case02 :: Assertion -case02 = expected @=? testStep step input +case02 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" @@ -55,7 +56,7 @@ case02 = expected @=? testStep step input ] case03 :: Assertion -case03 = expected @=? testStep step input +case03 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" @@ -72,7 +73,7 @@ case03 = expected @=? testStep step input ] case04 :: Assertion -case04 = expected @=? testStep step input +case04 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" @@ -92,7 +93,7 @@ case04 = expected @=? testStep step input ] case05 :: Assertion -case05 = expected @=? testStep step input +case05 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" @@ -112,7 +113,7 @@ case05 = expected @=? testStep step input ] case06 :: Assertion -case06 = expected @=? testStep step input +case06 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" @@ -122,7 +123,7 @@ case06 = expected @=? testStep step input expected = input case07 :: Assertion -case07 = expected @=? testStep step input +case07 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" @@ -132,7 +133,7 @@ case07 = expected @=? testStep step input expected = input case08 :: Assertion -case08 = expected @=? testStep step input +case08 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" @@ -145,3 +146,24 @@ case08 = expected @=? testStep step input , "" , "data Phantom a = Phantom" ] + +case09 :: Assertion +case09 = expected @=? testStep (step 4) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a b = Foo { a :: a, a2 :: String } | Bar { b :: a, c:: b }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a b = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" + , " | Bar" + , " { b :: a" + , " , c :: b" + , " }" + ] From 3b73abcdf320ad455067c61b08ab5cb0b13fb722 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 11:50:56 +0100 Subject: [PATCH 16/36] Fix warnings in Data.hs --- lib/Language/Haskell/Stylish/Step/Data.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 2a60eb0c..c37573c8 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,5 +1,6 @@ module Language.Haskell.Stylish.Step.Data where +import Prelude hiding (init) import Data.Maybe (maybeToList) import qualified Language.Haskell.Exts as H import Language.Haskell.Stylish.Block @@ -17,19 +18,19 @@ datas modu = type ChangeLine = Change String step :: Int -> Step -step indent = makeStep "Data" (step' indent) +step indentSize = makeStep "Data" (step' indentSize) step' :: Int -> Lines -> Module -> Lines -step' indent ls (module', _) = applyChanges changes ls +step' indentSize ls (module', _) = applyChanges changes ls where datas' = datas $ fmap linesFromSrcSpan module' - changes = datas' >>= (maybeToList . (changeDecl indent)) + changes = datas' >>= (maybeToList . (changeDecl indentSize)) changeDecl :: Int -> (LineBlock, H.Decl l) -> Maybe ChangeLine -changeDecl indent (block, H.DataDecl _ (H.DataType _) _ dhead decls _) = +changeDecl indentSize (block, H.DataDecl _ (H.DataType _) _ dhead decls _) = Just $ change block (const $ concat newLines) where - zipped = zip decls [1..] + zipped = zip decls ([1..] ::[Int]) newLines = fmap (\(decl, i) -> if (i == 1) then processConstructor typeConstructor decl else processConstructor (indented "| ") decl) zipped typeConstructor = "data " <> H.prettyPrint dhead <> " = " firstName (fname, _type) = indented "{ " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type @@ -40,5 +41,6 @@ changeDecl indent (block, H.DataDecl _ (H.DataType _) _ dhead decls _) = init <> H.prettyPrint dname : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [indented "}"] processConstructor init decl = [init <> trimLeft (H.prettyPrint decl)] - indented str = (replicate indent ' ') <> str + indented str = indent indentSize str + changeDecl _ _ = Nothing From dfdc6e3ed3c316b0a66fd6f369e967a426500336 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 11:59:58 +0100 Subject: [PATCH 17/36] Process derivings during record formatting MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Paweł Szulc --- lib/Language/Haskell/Stylish/Step/Data.hs | 5 +++-- .../Haskell/Stylish/Step/Data/Tests.hs | 20 +++++++++++++++++++ 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index c37573c8..b93bdfa2 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -27,11 +27,12 @@ step' indentSize ls (module', _) = applyChanges changes ls changes = datas' >>= (maybeToList . (changeDecl indentSize)) changeDecl :: Int -> (LineBlock, H.Decl l) -> Maybe ChangeLine -changeDecl indentSize (block, H.DataDecl _ (H.DataType _) _ dhead decls _) = +changeDecl indentSize (block, H.DataDecl _ (H.DataType _) _ dhead decls derivings) = Just $ change block (const $ concat newLines) where zipped = zip decls ([1..] ::[Int]) - newLines = fmap (\(decl, i) -> if (i == 1) then processConstructor typeConstructor decl else processConstructor (indented "| ") decl) zipped + newLines :: [[String]] + newLines = (fmap (\(decl, i) -> if (i == 1) then processConstructor typeConstructor decl else processConstructor (indented "| ") decl) zipped) ++ [fmap (\d -> indented $ H.prettyPrint d) derivings] typeConstructor = "data " <> H.prettyPrint dhead <> " = " firstName (fname, _type) = indented "{ " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type otherName (fname, _type) = indented ", " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 22e40652..76b9f908 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -19,6 +19,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 07" case07 , testCase "case 08" case08 , testCase "case 09" case09 + , testCase "case 10" case10 ] case01 :: Assertion @@ -167,3 +168,22 @@ case09 = expected @=? testStep (step 4) input , " , c :: b" , " }" ] + +case10 :: Assertion +case10 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo { a :: Int } deriving (Eq, Generic) deriving (Show)" + ] + + expected = unlines + [ "module Herp where" + , "" + , "data Foo = Foo" + , " { a :: Int" + , " }" + , " deriving (Eq, Generic)" + , " deriving (Show)" + ] From 6b8758fc1e9f7b1838d9e3a74fb1058aaf639333 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 12:06:38 +0100 Subject: [PATCH 18/36] Do not format when context is present MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Paweł Szulc --- lib/Language/Haskell/Stylish/Step/Data.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index b93bdfa2..23792ae7 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -27,7 +27,7 @@ step' indentSize ls (module', _) = applyChanges changes ls changes = datas' >>= (maybeToList . (changeDecl indentSize)) changeDecl :: Int -> (LineBlock, H.Decl l) -> Maybe ChangeLine -changeDecl indentSize (block, H.DataDecl _ (H.DataType _) _ dhead decls derivings) = +changeDecl indentSize (block, H.DataDecl _ (H.DataType _) Nothing dhead decls derivings) = Just $ change block (const $ concat newLines) where zipped = zip decls ([1..] ::[Int]) From 8d2451b019b0eebd0b1e9654e1d2285b77fbb3b7 Mon Sep 17 00:00:00 2001 From: Pawel Szulc Date: Fri, 17 Jan 2020 13:10:26 +0100 Subject: [PATCH 19/36] Add case 11 - deriving with DerivingStrategies --- .../Haskell/Stylish/Step/Data/Tests.hs | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 76b9f908..02dbb595 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -20,6 +20,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 08" case08 , testCase "case 09" case09 , testCase "case 10" case10 + , testCase "case 11" case11 ] case01 :: Assertion @@ -187,3 +188,23 @@ case10 = expected @=? testStep (step 2) input , " deriving (Eq, Generic)" , " deriving (Show)" ] + +case11 :: Assertion +case11 = expected @=? testStep (step 2) input + where + input = unlines + [ "{-# LANGUAGE DerivingStrategies #-}" + , "module Herp where" + , "" + , "data Foo = Foo { a :: Int } deriving stock (Show)" + ] + + expected = unlines + [ "{-# LANGUAGE DerivingStrategies #-}" + , "module Herp where" + , "" + , "data Foo = Foo" + , " { a :: Int" + , " }" + , " deriving stock (Show)" + ] From 6ee84d119050afd9a9cb9813fb59b1002ebf616d Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 13:21:59 +0100 Subject: [PATCH 20/36] Bugfix: do not remove empty data declarations MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Paweł Szulc --- lib/Language/Haskell/Stylish/Step/Data.hs | 1 + tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 14 +++++++++++++- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 23792ae7..fcb8f52a 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -27,6 +27,7 @@ step' indentSize ls (module', _) = applyChanges changes ls changes = datas' >>= (maybeToList . (changeDecl indentSize)) changeDecl :: Int -> (LineBlock, H.Decl l) -> Maybe ChangeLine +changeDecl _ (_, H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing changeDecl indentSize (block, H.DataDecl _ (H.DataType _) Nothing dhead decls derivings) = Just $ change block (const $ concat newLines) where diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 02dbb595..7f3f11a5 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -10,7 +10,8 @@ import Test.HUnit (Assertion, (@=?)) tests :: Test tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" - [ testCase "case 01" case01 + [ testCase "case 00" case00 + , testCase "case 01" case01 , testCase "case 02" case02 , testCase "case 03" case03 , testCase "case 04" case04 @@ -23,6 +24,17 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 11" case11 ] +case00 :: Assertion +case00 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo" + ] + + expected = input + case01 :: Assertion case01 = expected @=? testStep (step 2) input where From caf64da65c535e9d7d5fd7cbf38a45ad16dbdff2 Mon Sep 17 00:00:00 2001 From: Pawel Szulc Date: Fri, 17 Jan 2020 13:28:40 +0100 Subject: [PATCH 21/36] Update README example with ability to format records --- README.markdown | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/README.markdown b/README.markdown index 870a40cb..54451ccd 100644 --- a/README.markdown +++ b/README.markdown @@ -56,10 +56,7 @@ import System.Directory (doesFileExist) import qualified Data.Map as M import Data.Map ((!), keys, Map) -data Point = Point - { pointX, pointY :: Double - , pointName :: String - } deriving (Show) +data Point = Point { pointX, pointY :: Double , pointName :: String} deriving (Show) ``` into: From 53d7d537a9d4f307b20d81de2d373f2d37a6702f Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 14:15:12 +0100 Subject: [PATCH 22/36] Add case12 (Point) --- .../Haskell/Stylish/Step/Data/Tests.hs | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 7f3f11a5..712bdb4f 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -22,6 +22,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 09" case09 , testCase "case 10" case10 , testCase "case 11" case11 + , testCase "case 12" case12 ] case00 :: Assertion @@ -220,3 +221,21 @@ case11 = expected @=? testStep (step 2) input , " }" , " deriving stock (Show)" ] + +case12 :: Assertion +case12 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Point = Point { pointX, pointY :: Double , pointName :: String} deriving (Show)" + ] + + expected = unlines + [ "module Herp where" + , "" + , "data Point = Point" + , " { pointX, pointY :: Double" + , " , pointName :: String" + , " deriving (Show)" + ] From 11785de364ecc0a996e5be668a834045a20596cd Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 14:39:18 +0100 Subject: [PATCH 23/36] Fix case 12 --- lib/Language/Haskell/Stylish/Step/Data.hs | 7 ++++--- tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 5 +++-- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index fcb8f52a..288f874e 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,6 +1,7 @@ module Language.Haskell.Stylish.Step.Data where import Prelude hiding (init) +import Data.List (intercalate) import Data.Maybe (maybeToList) import qualified Language.Haskell.Exts as H import Language.Haskell.Stylish.Block @@ -35,9 +36,9 @@ changeDecl indentSize (block, H.DataDecl _ (H.DataType _) Nothing dhead decls de newLines :: [[String]] newLines = (fmap (\(decl, i) -> if (i == 1) then processConstructor typeConstructor decl else processConstructor (indented "| ") decl) zipped) ++ [fmap (\d -> indented $ H.prettyPrint d) derivings] typeConstructor = "data " <> H.prettyPrint dhead <> " = " - firstName (fname, _type) = indented "{ " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type - otherName (fname, _type) = indented ", " <> H.prettyPrint fname <> " :: " <> H.prettyPrint _type - extractField (H.FieldDecl _ names _type) = (head names, _type) + firstName (fnames, _type) = indented "{ " <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type + otherName (fnames, _type) = indented ", " <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type + extractField (H.FieldDecl _ names _type) = (names, _type) processConstructor init (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do init <> H.prettyPrint dname : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [indented "}"] diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 712bdb4f..9a971a94 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -223,7 +223,7 @@ case11 = expected @=? testStep (step 2) input ] case12 :: Assertion -case12 = expected @=? testStep (step 2) input +case12 = expected @=? testStep (step 4) input where input = unlines [ "module Herp where" @@ -236,6 +236,7 @@ case12 = expected @=? testStep (step 2) input , "" , "data Point = Point" , " { pointX, pointY :: Double" - , " , pointName :: String" + , " , pointName :: String" + , " }" , " deriving (Show)" ] From 6ea58d8914ff214fa950c657cf542dfe30274e5d Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Fri, 17 Jan 2020 14:39:43 +0100 Subject: [PATCH 24/36] Factor out processName --- lib/Language/Haskell/Stylish/Step/Data.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 288f874e..a60533cb 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -36,12 +36,11 @@ changeDecl indentSize (block, H.DataDecl _ (H.DataType _) Nothing dhead decls de newLines :: [[String]] newLines = (fmap (\(decl, i) -> if (i == 1) then processConstructor typeConstructor decl else processConstructor (indented "| ") decl) zipped) ++ [fmap (\d -> indented $ H.prettyPrint d) derivings] typeConstructor = "data " <> H.prettyPrint dhead <> " = " - firstName (fnames, _type) = indented "{ " <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type - otherName (fnames, _type) = indented ", " <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type + processName init (fnames, _type) = indented init <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type extractField (H.FieldDecl _ names _type) = (names, _type) processConstructor init (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do - init <> H.prettyPrint dname : (firstName $ extractField $ head fields) : (fmap (otherName . extractField) (tail fields)) ++ [indented "}"] + init <> H.prettyPrint dname : (processName "{ " $ extractField $ head fields) : (fmap (processName ", " . extractField) (tail fields)) ++ [indented "}"] processConstructor init decl = [init <> trimLeft (H.prettyPrint decl)] indented str = indent indentSize str From 3b9500c72aa68c765d82186bf3d6fdc99199c89f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=81ukasz=20Go=C5=82=C4=99biewski?= Date: Fri, 17 Jan 2020 14:50:51 +0100 Subject: [PATCH 25/36] Apply hlint suggestions --- lib/Language/Haskell/Stylish/Step/Data.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index a60533cb..dab941a5 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,13 +1,13 @@ module Language.Haskell.Stylish.Step.Data where -import Prelude hiding (init) -import Data.List (intercalate) +import Data.List (intercalate) import Data.Maybe (maybeToList) import qualified Language.Haskell.Exts as H import Language.Haskell.Stylish.Block import Language.Haskell.Stylish.Editor import Language.Haskell.Stylish.Step import Language.Haskell.Stylish.Util +import Prelude hiding (init) datas :: H.Module l -> [(l, H.Decl l)] datas modu = @@ -25,7 +25,7 @@ step' :: Int -> Lines -> Module -> Lines step' indentSize ls (module', _) = applyChanges changes ls where datas' = datas $ fmap linesFromSrcSpan module' - changes = datas' >>= (maybeToList . (changeDecl indentSize)) + changes = datas' >>= maybeToList . changeDecl indentSize changeDecl :: Int -> (LineBlock, H.Decl l) -> Maybe ChangeLine changeDecl _ (_, H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing @@ -34,15 +34,15 @@ changeDecl indentSize (block, H.DataDecl _ (H.DataType _) Nothing dhead decls de where zipped = zip decls ([1..] ::[Int]) newLines :: [[String]] - newLines = (fmap (\(decl, i) -> if (i == 1) then processConstructor typeConstructor decl else processConstructor (indented "| ") decl) zipped) ++ [fmap (\d -> indented $ H.prettyPrint d) derivings] + newLines = fmap (\(decl, i) -> if i == 1 then processConstructor typeConstructor decl else processConstructor (indented "| ") decl) zipped ++ [fmap (indented . H.prettyPrint) derivings] typeConstructor = "data " <> H.prettyPrint dhead <> " = " processName init (fnames, _type) = indented init <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type extractField (H.FieldDecl _ names _type) = (names, _type) - processConstructor init (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do - init <> H.prettyPrint dname : (processName "{ " $ extractField $ head fields) : (fmap (processName ", " . extractField) (tail fields)) ++ [indented "}"] + processConstructor init (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = + init <> H.prettyPrint dname : processName "{ " ( extractField $ head fields) : fmap (processName ", " . extractField) (tail fields) ++ [indented "}"] processConstructor init decl = [init <> trimLeft (H.prettyPrint decl)] - indented str = indent indentSize str + indented = indent indentSize changeDecl _ _ = Nothing From 33bd59a58f85b9b2f9a014ea3c1725717de81b31 Mon Sep 17 00:00:00 2001 From: Pawel Szulc Date: Fri, 17 Jan 2020 15:03:16 +0100 Subject: [PATCH 26/36] Extract constructors helper function --- lib/Language/Haskell/Stylish/Step/Data.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index dab941a5..02a6127e 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -33,8 +33,10 @@ changeDecl indentSize (block, H.DataDecl _ (H.DataType _) Nothing dhead decls de Just $ change block (const $ concat newLines) where zipped = zip decls ([1..] ::[Int]) - newLines :: [[String]] - newLines = fmap (\(decl, i) -> if i == 1 then processConstructor typeConstructor decl else processConstructor (indented "| ") decl) zipped ++ [fmap (indented . H.prettyPrint) derivings] + newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] + + constructors (decl, 1) = processConstructor typeConstructor decl + constructors (decl, _) = processConstructor (indented "| ") decl typeConstructor = "data " <> H.prettyPrint dhead <> " = " processName init (fnames, _type) = indented init <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type extractField (H.FieldDecl _ names _type) = (names, _type) From 6eb3ae03b95264bc132031a98fcb039fb2529aeb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=81ukasz=20Go=C5=82=C4=99biewski?= Date: Sat, 18 Jan 2020 20:17:42 +0100 Subject: [PATCH 27/36] Make 'indent' global --- data/stylish-haskell.yaml | 6 ++++-- lib/Language/Haskell/Stylish/Config.hs | 18 ++++++++++-------- tests/Language/Haskell/Stylish/Config/Tests.hs | 1 + 3 files changed, 15 insertions(+), 10 deletions(-) diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 3fa21056..209d6131 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -16,8 +16,7 @@ steps: # add_language_pragma: true # Format record definitions - - records: - indent: 4 + - records: {} # Align the right hand side of some elements. This is quite conservative # and only applies to statements where each element occupies a single @@ -226,6 +225,9 @@ 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 7b199ad6..852df8ed 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -52,12 +52,13 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config - { configSteps :: [Step] - , configColumns :: Maybe Int - , configLanguageExtensions :: [String] - , configNewline :: IO.Newline - , configCabal :: Bool - } + { configSteps :: [Step] + , configIndent :: Int + , configColumns :: Maybe Int + , configLanguageExtensions :: [String] + , configNewline :: IO.Newline + , configCabal :: Bool + } -------------------------------------------------------------------------------- @@ -120,6 +121,7 @@ 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) @@ -184,8 +186,8 @@ parseSimpleAlign c o = SimpleAlign.step -------------------------------------------------------------------------------- parseRecords :: Config -> A.Object -> A.Parser Step -parseRecords _ o = Data.step - <$> (o A..:? "indent" A..!= 4) +parseRecords c _ = Data.step + <$> pure (configIndent c) -------------------------------------------------------------------------------- diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index c89077f3..f8869ce6 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -166,6 +166,7 @@ dotStylish = unlines $ , " remove_redundant: true" , " - trailing_whitespace: {}" , " - records: {}" + , "indent: 2" , "columns: 110" , "language_extensions:" , " - TemplateHaskell" From 6e7547ca8a1de9c8d7c6a846551824a8e2a5539a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=81ukasz=20Go=C5=82=C4=99biewski?= Date: Sat, 18 Jan 2020 20:23:55 +0100 Subject: [PATCH 28/36] Remove unused Stylish.records method --- lib/Language/Haskell/Stylish.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index c39b63a2..a40a7d2a 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -39,10 +39,6 @@ import Language.Haskell.Stylish.Verbose import Paths_stylish_haskell (version) --------------------------------------------------------------------------------- -records :: Step -records = Data.step - -------------------------------------------------------------------------------- simpleAlign :: Maybe Int -- ^ Columns -> SimpleAlign.Config From b33fba1068b2789c24bcdbd69da32c260f4fe22a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=81ukasz=20Go=C5=82=C4=99biewski?= Date: Sat, 18 Jan 2020 20:32:31 +0100 Subject: [PATCH 29/36] Fix Config formatting in Config.hs --- lib/Language/Haskell/Stylish/Config.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 852df8ed..bd158671 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -52,13 +52,13 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config - { configSteps :: [Step] - , configIndent :: Int - , configColumns :: Maybe Int - , configLanguageExtensions :: [String] - , configNewline :: IO.Newline - , configCabal :: Bool - } + { configSteps :: [Step] + , configIndent :: Int + , configColumns :: Maybe Int + , configLanguageExtensions :: [String] + , configNewline :: IO.Newline + , configCabal :: Bool + } -------------------------------------------------------------------------------- From a73a79fe124a43be77cdd1a2cd04c13211568870 Mon Sep 17 00:00:00 2001 From: Pawel Szulc Date: Mon, 20 Jan 2020 10:22:35 +0100 Subject: [PATCH 30/36] Extract processConstructor function MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- lib/Language/Haskell/Stylish/Step/Data.hs | 25 ++++++++++++----------- 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 02a6127e..be32ed07 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -32,19 +32,20 @@ changeDecl _ (_, H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing changeDecl indentSize (block, H.DataDecl _ (H.DataType _) Nothing dhead decls derivings) = Just $ change block (const $ concat newLines) where - zipped = zip decls ([1..] ::[Int]) newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] - - constructors (decl, 1) = processConstructor typeConstructor decl - constructors (decl, _) = processConstructor (indented "| ") decl + zipped = zip decls ([1..] ::[Int]) + constructors (decl, 1) = processConstructor typeConstructor indentSize decl + constructors (decl, _) = processConstructor (indented "| ") indentSize decl typeConstructor = "data " <> H.prettyPrint dhead <> " = " - processName init (fnames, _type) = indented init <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type - extractField (H.FieldDecl _ names _type) = (names, _type) - - processConstructor init (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = - init <> H.prettyPrint dname : processName "{ " ( extractField $ head fields) : fmap (processName ", " . extractField) (tail fields) ++ [indented "}"] - processConstructor init decl = [init <> trimLeft (H.prettyPrint decl)] - indented = indent indentSize - changeDecl _ _ = Nothing + +processConstructor :: String -> Int -> H.QualConDecl l -> [String] +processConstructor init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = + init <> H.prettyPrint dname : processName "{ " ( extractField $ head fields) : fmap (processName ", " . extractField) (tail fields) ++ [indented "}"] + where + processName prefix (fnames, _type) = + indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type + extractField (H.FieldDecl _ names _type) = (names, _type) + indented = indent indentSize +processConstructor init _ decl = [init <> trimLeft (H.prettyPrint decl)] From 7ad30553d11da6f7ad2a77c703a1f046cda428c2 Mon Sep 17 00:00:00 2001 From: Pawel Szulc Date: Mon, 20 Jan 2020 10:44:07 +0100 Subject: [PATCH 31/36] Refactor datas function MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- lib/Language/Haskell/Stylish/Step/Data.hs | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index be32ed07..13b9287d 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -9,12 +9,9 @@ import Language.Haskell.Stylish.Step import Language.Haskell.Stylish.Util import Prelude hiding (init) -datas :: H.Module l -> [(l, H.Decl l)] -datas modu = - [ (l, H.DataDecl l b c d e f) - | H.Module _ _ _ _ decls <- [modu] - , H.DataDecl l b c d e f <- decls - ] +datas :: H.Module l -> [H.Decl l] +datas (H.Module _ _ _ _ decls) = decls +datas _ = [] type ChangeLine = Change String @@ -27,9 +24,9 @@ step' indentSize ls (module', _) = applyChanges changes ls datas' = datas $ fmap linesFromSrcSpan module' changes = datas' >>= maybeToList . changeDecl indentSize -changeDecl :: Int -> (LineBlock, H.Decl l) -> Maybe ChangeLine -changeDecl _ (_, H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing -changeDecl indentSize (block, H.DataDecl _ (H.DataType _) Nothing dhead decls derivings) = +changeDecl :: Int -> H.Decl LineBlock -> Maybe ChangeLine +changeDecl _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing +changeDecl indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) = Just $ change block (const $ concat newLines) where newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] From 0d62b822c37c9392add594307e0def2a6c23ff61 Mon Sep 17 00:00:00 2001 From: Pawel Szulc Date: Wed, 22 Jan 2020 19:07:07 +0100 Subject: [PATCH 32/36] Include comments with AST. Two tests are still failing... --- lib/Language/Haskell/Stylish/Step/Data.hs | 20 +++-- .../Haskell/Stylish/Step/Data/Tests.hs | 82 +++++++++++++++++++ 2 files changed, 93 insertions(+), 9 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 13b9287d..06f30e41 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -3,13 +3,14 @@ module Language.Haskell.Stylish.Step.Data where import Data.List (intercalate) import Data.Maybe (maybeToList) import qualified Language.Haskell.Exts as H +import Language.Haskell.Exts.Comments import Language.Haskell.Stylish.Block import Language.Haskell.Stylish.Editor import Language.Haskell.Stylish.Step import Language.Haskell.Stylish.Util import Prelude hiding (init) -datas :: H.Module l -> [H.Decl l] +datas :: H.Module (l, c) -> [H.Decl (l, c)] datas (H.Module _ _ _ _ decls) = decls datas _ = [] @@ -19,14 +20,15 @@ step :: Int -> Step step indentSize = makeStep "Data" (step' indentSize) step' :: Int -> Lines -> Module -> Lines -step' indentSize ls (module', _) = applyChanges changes ls +step' indentSize ls module' = applyChanges changes ls where - datas' = datas $ fmap linesFromSrcSpan module' + module'' = associateHaddock module' + datas' = datas $ fmap (\(i, c) -> (linesFromSrcSpan i, c)) module'' changes = datas' >>= maybeToList . changeDecl indentSize -changeDecl :: Int -> H.Decl LineBlock -> Maybe ChangeLine +changeDecl :: Int -> H.Decl (LineBlock, [Comment]) -> Maybe ChangeLine changeDecl _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing -changeDecl indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) = +changeDecl indentSize (H.DataDecl (block, _) (H.DataType _) Nothing dhead decls derivings) = Just $ change block (const $ concat newLines) where newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] @@ -37,12 +39,12 @@ changeDecl indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls deriv indented = indent indentSize changeDecl _ _ = Nothing -processConstructor :: String -> Int -> H.QualConDecl l -> [String] +processConstructor :: String -> Int -> H.QualConDecl (LineBlock, [Comment]) -> [String] processConstructor init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = init <> H.prettyPrint dname : processName "{ " ( extractField $ head fields) : fmap (processName ", " . extractField) (tail fields) ++ [indented "}"] where - processName prefix (fnames, _type) = - indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type - extractField (H.FieldDecl _ names _type) = (names, _type) + processName prefix (fnames, _type, comments) = + indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> (concat $ fmap show comments) + extractField (H.FieldDecl (_, comments) names _type) = (names, _type, comments) indented = indent indentSize 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 9a971a94..864f96b6 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -23,6 +23,10 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 10" case10 , testCase "case 11" case11 , testCase "case 12" case12 + , testCase "case 13" case13 + , testCase "case 14" case14 +-- , testCase "case 15" case15 +-- , testCase "case 16" case16 ] case00 :: Assertion @@ -240,3 +244,81 @@ case12 = expected @=? testStep (step 4) input , " }" , " deriving (Show)" ] + +case13 :: Assertion +case13 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "-- this is a comment" + , "data Foo = Foo { a :: Int }" + ] + expected = unlines + [ "module Herp where" + , "" + , "-- this is a comment" + , "data Foo = Foo" + , " { a :: Int" + , " }" + ] + +case14 :: Assertion +case14 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "{- this is" + , " a comment -}" + , "data Foo = Foo { a :: Int }" + ] + expected = unlines + [ "module Herp where" + , "" + , "{- this is" + , " a comment -}" + , "data Foo = Foo" + , " { a :: Int" + , " }" + ] + +case15 :: Assertion +case15 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo" + , " { a :: Int -- comment" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo = Foo" + , " { a :: Int -- comment" + , " }" + ] + +case16 :: Assertion +case16 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a" + , "-- comment" + , " , a2 :: String" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a" + , "-- comment" + , " , a2 :: String" + , " }" + ] From 86b6eb837d2cddbd3a02a19a2852be4161ff088b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=81ukasz=20Go=C5=82=C4=99biewski?= Date: Wed, 22 Jan 2020 20:57:08 +0100 Subject: [PATCH 33/36] Fix cases 15 and 16 --- lib/Language/Haskell/Stylish/Step/Data.hs | 22 ++++++++++++------- .../Haskell/Stylish/Step/Data/Tests.hs | 12 +++++----- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 06f30e41..d8524e75 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -29,9 +29,12 @@ step' indentSize ls module' = applyChanges changes ls changeDecl :: Int -> H.Decl (LineBlock, [Comment]) -> Maybe ChangeLine changeDecl _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing changeDecl indentSize (H.DataDecl (block, _) (H.DataType _) Nothing dhead decls derivings) = - Just $ change block (const $ concat newLines) + fmap (\l -> change block (const $ concat l)) newLines where - newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] + newLines = if Nothing `elem` maybeConstructors then Nothing + else Just $ fmap concat maybeConstructors ++ [fmap (indented . H.prettyPrint) derivings] + maybeConstructors :: [Maybe [String]] + maybeConstructors = fmap constructors zipped zipped = zip decls ([1..] ::[Int]) constructors (decl, 1) = processConstructor typeConstructor indentSize decl constructors (decl, _) = processConstructor (indented "| ") indentSize decl @@ -39,12 +42,15 @@ changeDecl indentSize (H.DataDecl (block, _) (H.DataType _) Nothing dhead decls indented = indent indentSize changeDecl _ _ = Nothing -processConstructor :: String -> Int -> H.QualConDecl (LineBlock, [Comment]) -> [String] -processConstructor init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = - init <> H.prettyPrint dname : processName "{ " ( extractField $ head fields) : fmap (processName ", " . extractField) (tail fields) ++ [indented "}"] +processConstructor :: String -> Int -> H.QualConDecl (LineBlock, [Comment]) -> Maybe [String] +processConstructor init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do + n1 <- processName "{ " ( extractField $ head fields) + ns <- traverse (processName ", " . extractField) (tail fields) + Just $ init <> H.prettyPrint dname : n1 : ns ++ [indented "}"] where - processName prefix (fnames, _type, comments) = - indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> (concat $ fmap show comments) + processName prefix (fnames, _type, []) = Just $ + indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type + processName _ _ = Nothing extractField (H.FieldDecl (_, comments) names _type) = (names, _type, comments) indented = indent indentSize -processConstructor init _ decl = [init <> trimLeft (H.prettyPrint decl)] +processConstructor init _ decl = Just [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 864f96b6..ff0aa34d 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -25,8 +25,8 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 12" case12 , testCase "case 13" case13 , testCase "case 14" case14 --- , testCase "case 15" case15 --- , testCase "case 16" case16 + , testCase "case 15" case15 + , testCase "case 16" case16 ] case00 :: Assertion @@ -290,14 +290,14 @@ case15 = expected @=? testStep (step 2) input [ "module Herp where" , "" , "data Foo = Foo" - , " { a :: Int -- comment" + , " { a :: Int -- ^ comment" , " }" ] expected = unlines [ "module Herp where" , "" , "data Foo = Foo" - , " { a :: Int -- comment" + , " { a :: Int -- ^ comment" , " }" ] @@ -309,7 +309,7 @@ case16 = expected @=? testStep (step 2) input , "" , "data Foo a = Foo" , " { a :: a" - , "-- comment" + , "-- ^ comment" , " , a2 :: String" , " }" ] @@ -318,7 +318,7 @@ case16 = expected @=? testStep (step 2) input , "" , "data Foo a = Foo" , " { a :: a" - , "-- comment" + , "-- ^ comment" , " , a2 :: String" , " }" ] From 3dc1fb22e4330da7bd0491d99e348c93516c811d Mon Sep 17 00:00:00 2001 From: Pawel Szulc Date: Thu, 23 Jan 2020 10:33:08 +0100 Subject: [PATCH 34/36] Do not format records when comments within MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Łukasz Gołębiewski --- lib/Language/Haskell/Stylish/Step/Data.hs | 45 +++++++++----- .../Haskell/Stylish/Step/Data/Tests.hs | 60 ++++++++++++++++--- 2 files changed, 83 insertions(+), 22 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index d8524e75..f0232466 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,6 +1,7 @@ module Language.Haskell.Stylish.Step.Data where import Data.List (intercalate) +import Data.List (find) import Data.Maybe (maybeToList) import qualified Language.Haskell.Exts as H import Language.Haskell.Exts.Comments @@ -22,35 +23,51 @@ step indentSize = makeStep "Data" (step' indentSize) step' :: Int -> Lines -> Module -> Lines step' indentSize ls module' = applyChanges changes ls where + allComments = snd module' module'' = associateHaddock module' datas' = datas $ fmap (\(i, c) -> (linesFromSrcSpan i, c)) module'' - changes = datas' >>= maybeToList . changeDecl indentSize + changes = datas' >>= maybeToList . changeDecl allComments indentSize -changeDecl :: Int -> H.Decl (LineBlock, [Comment]) -> Maybe ChangeLine -changeDecl _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing -changeDecl indentSize (H.DataDecl (block, _) (H.DataType _) Nothing dhead decls derivings) = - fmap (\l -> change block (const $ concat l)) newLines +findComment :: LineBlock -> [Comment] -> Maybe Comment +findComment lb = find foo + where + foo (Comment _ (H.SrcSpan _ start _ end _) _) = + (blockStart lb) == start && (blockEnd lb) == end + +commentWithin :: LineBlock -> [Comment] -> Maybe Comment +commentWithin lb = find foo + where + foo (Comment _ (H.SrcSpan _ start _ end _) _) = + start >= (blockStart lb) && end <= (blockEnd lb) + +changeDecl :: [Comment] -> Int -> H.Decl (LineBlock, [Comment]) -> Maybe ChangeLine +changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing +changeDecl allComments indentSize (H.DataDecl (block, _) (H.DataType _) Nothing dhead decls derivings) + | commentWithin block allComments == Nothing = fmap (\l -> change block (const $ concat l)) newLines + | otherwise = Nothing where newLines = if Nothing `elem` maybeConstructors then Nothing else Just $ fmap concat maybeConstructors ++ [fmap (indented . H.prettyPrint) derivings] maybeConstructors :: [Maybe [String]] maybeConstructors = fmap constructors zipped zipped = zip decls ([1..] ::[Int]) - constructors (decl, 1) = processConstructor typeConstructor indentSize decl - constructors (decl, _) = processConstructor (indented "| ") indentSize decl + constructors (decl, 1) = processConstructor allComments typeConstructor indentSize decl + constructors (decl, _) = processConstructor allComments (indented "| ") indentSize decl typeConstructor = "data " <> H.prettyPrint dhead <> " = " indented = indent indentSize -changeDecl _ _ = Nothing +changeDecl _ _ _ = Nothing -processConstructor :: String -> Int -> H.QualConDecl (LineBlock, [Comment]) -> Maybe [String] -processConstructor init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do +processConstructor :: [Comment] -> String -> Int -> H.QualConDecl (LineBlock, [Comment]) -> Maybe [String] +processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do n1 <- processName "{ " ( extractField $ head fields) ns <- traverse (processName ", " . extractField) (tail fields) Just $ init <> H.prettyPrint dname : n1 : ns ++ [indented "}"] where - processName prefix (fnames, _type, []) = Just $ + processName prefix (fnames, _type, Nothing) = Just $ indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type - processName _ _ = Nothing - extractField (H.FieldDecl (_, comments) names _type) = (names, _type, comments) + processName prefix (fnames, _type, (Just (Comment _ _ c))) = Just $ + indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> " --" <> c + -- processName _ _ = Nothing + extractField (H.FieldDecl (lb, _) names _type) = (names, _type, findComment lb allComments) indented = indent indentSize -processConstructor init _ decl = Just [init <> trimLeft (H.prettyPrint decl)] +processConstructor _ init _ decl = Just [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 ff0aa34d..b1528192 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -27,6 +27,8 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 14" case14 , testCase "case 15" case15 , testCase "case 16" case16 + , testCase "case 17" case17 + , testCase "case 18" case18 ] case00 :: Assertion @@ -289,15 +291,15 @@ case15 = expected @=? testStep (step 2) input input = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int -- ^ comment" + , "data Foo = Foo {" + , " a :: Int -- ^ comment" , " }" ] expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int -- ^ comment" + , "data Foo = Foo {" + , " a :: Int -- ^ comment" , " }" ] @@ -308,17 +310,59 @@ case16 = expected @=? testStep (step 2) input [ "module Herp where" , "" , "data Foo a = Foo" - , " { a :: a" + , " { a :: a," , "-- ^ comment" - , " , a2 :: String" + , " a2 :: String" , " }" ] expected = unlines [ "module Herp where" , "" , "data Foo a = Foo" - , " { a :: a" + , " { a :: a," , "-- ^ comment" - , " , a2 :: String" + , " a2 :: String" + , " }" + ] + +case17 :: Assertion +case17 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a, -- comment" + , " a2 :: String" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a, -- comment" + , " a2 :: String" + , " }" + ] + +case18 :: Assertion +case18 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a," + , "-- comment " + , " a2 :: String" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a," + , "-- comment " + , " a2 :: String" , " }" ] From dcd2d5131045ead68854ed8a54222aab3c914cd0 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Thu, 23 Jan 2020 17:22:16 +0100 Subject: [PATCH 35/36] Clean-up Data.hs --- lib/Language/Haskell/Stylish/Step/Data.hs | 28 ++++++++++------------- 1 file changed, 12 insertions(+), 16 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index f0232466..86022998 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,8 +1,7 @@ module Language.Haskell.Stylish.Step.Data where -import Data.List (intercalate) -import Data.List (find) -import Data.Maybe (maybeToList) +import Data.List (find, intercalate) +import Data.Maybe (isNothing, maybeToList) import qualified Language.Haskell.Exts as H import Language.Haskell.Exts.Comments import Language.Haskell.Stylish.Block @@ -11,7 +10,7 @@ import Language.Haskell.Stylish.Step import Language.Haskell.Stylish.Util import Prelude hiding (init) -datas :: H.Module (l, c) -> [H.Decl (l, c)] +datas :: H.Module l -> [H.Decl l] datas (H.Module _ _ _ _ decls) = decls datas _ = [] @@ -21,29 +20,27 @@ step :: Int -> Step step indentSize = makeStep "Data" (step' indentSize) step' :: Int -> Lines -> Module -> Lines -step' indentSize ls module' = applyChanges changes ls +step' indentSize ls (module', allComments) = applyChanges changes ls where - allComments = snd module' - module'' = associateHaddock module' - datas' = datas $ fmap (\(i, c) -> (linesFromSrcSpan i, c)) module'' + datas' = datas $ fmap linesFromSrcSpan module' changes = datas' >>= maybeToList . changeDecl allComments indentSize findComment :: LineBlock -> [Comment] -> Maybe Comment findComment lb = find foo where foo (Comment _ (H.SrcSpan _ start _ end _) _) = - (blockStart lb) == start && (blockEnd lb) == end + blockStart lb == start && blockEnd lb == end commentWithin :: LineBlock -> [Comment] -> Maybe Comment commentWithin lb = find foo where foo (Comment _ (H.SrcSpan _ start _ end _) _) = - start >= (blockStart lb) && end <= (blockEnd lb) + start >= blockStart lb && end <= blockEnd lb -changeDecl :: [Comment] -> Int -> H.Decl (LineBlock, [Comment]) -> Maybe ChangeLine +changeDecl :: [Comment] -> Int -> H.Decl LineBlock -> Maybe ChangeLine changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing -changeDecl allComments indentSize (H.DataDecl (block, _) (H.DataType _) Nothing dhead decls derivings) - | commentWithin block allComments == Nothing = fmap (\l -> change block (const $ concat l)) newLines +changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) + | isNothing $ commentWithin block allComments = fmap (\l -> change block (const $ concat l)) newLines | otherwise = Nothing where newLines = if Nothing `elem` maybeConstructors then Nothing @@ -57,7 +54,7 @@ changeDecl allComments indentSize (H.DataDecl (block, _) (H.DataType _) Nothing indented = indent indentSize changeDecl _ _ _ = Nothing -processConstructor :: [Comment] -> String -> Int -> H.QualConDecl (LineBlock, [Comment]) -> Maybe [String] +processConstructor :: [Comment] -> String -> Int -> H.QualConDecl LineBlock -> Maybe [String] processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do n1 <- processName "{ " ( extractField $ head fields) ns <- traverse (processName ", " . extractField) (tail fields) @@ -67,7 +64,6 @@ processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type processName prefix (fnames, _type, (Just (Comment _ _ c))) = Just $ indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> " --" <> c - -- processName _ _ = Nothing - extractField (H.FieldDecl (lb, _) names _type) = (names, _type, findComment lb allComments) + extractField (H.FieldDecl lb names _type) = (names, _type, findComment lb allComments) indented = indent indentSize processConstructor _ init _ decl = Just [init <> trimLeft (H.prettyPrint decl)] From c28c8036ae2ea7264fd9fa8e695f0fe8502cca09 Mon Sep 17 00:00:00 2001 From: Lukasz Golebiewski Date: Thu, 23 Jan 2020 17:33:13 +0100 Subject: [PATCH 36/36] Refactor Data.hs --- lib/Language/Haskell/Stylish/Step/Data.hs | 33 +++++++++++------------ 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 86022998..9acd22b1 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,7 +1,7 @@ module Language.Haskell.Stylish.Step.Data where import Data.List (find, intercalate) -import Data.Maybe (isNothing, maybeToList) +import Data.Maybe (maybeToList) import qualified Language.Haskell.Exts as H import Language.Haskell.Exts.Comments import Language.Haskell.Stylish.Block @@ -26,27 +26,24 @@ step' indentSize ls (module', allComments) = applyChanges changes ls changes = datas' >>= maybeToList . changeDecl allComments indentSize findComment :: LineBlock -> [Comment] -> Maybe Comment -findComment lb = find foo +findComment lb = find commentOnLine where - foo (Comment _ (H.SrcSpan _ start _ end _) _) = + commentOnLine (Comment _ (H.SrcSpan _ start _ end _) _) = blockStart lb == start && blockEnd lb == end -commentWithin :: LineBlock -> [Comment] -> Maybe Comment -commentWithin lb = find foo +commentsWithin :: LineBlock -> [Comment] -> [Comment] +commentsWithin lb = filter within where - foo (Comment _ (H.SrcSpan _ start _ end _) _) = + within (Comment _ (H.SrcSpan _ start _ end _) _) = start >= blockStart lb && end <= blockEnd lb changeDecl :: [Comment] -> Int -> H.Decl LineBlock -> Maybe ChangeLine changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) - | isNothing $ commentWithin block allComments = fmap (\l -> change block (const $ concat l)) newLines + | null $ commentsWithin block allComments = Just $ change block (const $ concat newLines) | otherwise = Nothing where - newLines = if Nothing `elem` maybeConstructors then Nothing - else Just $ fmap concat maybeConstructors ++ [fmap (indented . H.prettyPrint) derivings] - maybeConstructors :: [Maybe [String]] - maybeConstructors = fmap constructors zipped + newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] zipped = zip decls ([1..] ::[Int]) constructors (decl, 1) = processConstructor allComments typeConstructor indentSize decl constructors (decl, _) = processConstructor allComments (indented "| ") indentSize decl @@ -54,16 +51,16 @@ changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead indented = indent indentSize changeDecl _ _ _ = Nothing -processConstructor :: [Comment] -> String -> Int -> H.QualConDecl LineBlock -> Maybe [String] +processConstructor :: [Comment] -> String -> Int -> H.QualConDecl LineBlock -> [String] processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do - n1 <- processName "{ " ( extractField $ head fields) - ns <- traverse (processName ", " . extractField) (tail fields) - Just $ init <> H.prettyPrint dname : n1 : ns ++ [indented "}"] + init <> H.prettyPrint dname : n1 : ns ++ [indented "}"] where - processName prefix (fnames, _type, Nothing) = Just $ + n1 = processName "{ " ( extractField $ head fields) + ns = fmap (processName ", " . extractField) (tail fields) + processName prefix (fnames, _type, Nothing) = indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type - processName prefix (fnames, _type, (Just (Comment _ _ c))) = Just $ + processName prefix (fnames, _type, (Just (Comment _ _ c))) = indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> " --" <> c extractField (H.FieldDecl lb names _type) = (names, _type, findComment lb allComments) indented = indent indentSize -processConstructor _ init _ decl = Just [init <> trimLeft (H.prettyPrint decl)] +processConstructor _ init _ decl = [init <> trimLeft (H.prettyPrint decl)]