diff options
author | Łukasz Gołębiewski <lukasz.golebiewski@gmail.com> | 2020-01-23 17:43:04 +0100 |
---|---|---|
committer | GitHub <noreply@github.com> | 2020-01-23 17:43:04 +0100 |
commit | 8065c3c074719bd13db67b5ec74db560609a4e64 (patch) | |
tree | b4cd6715cd196eecabe488caaab6b9a24ab637a1 | |
parent | 1a869950eba47e30ebe84e118f404ef9a62e9cc6 (diff) | |
download | stylish-haskell-8065c3c074719bd13db67b5ec74db560609a4e64.tar.gz |
Support for records formatting (#256)
* Initial test describing simplest scenario for Data step
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* [sanity-check] Delete data defs
* Extract changeDecl
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* First green test :-)
* Cover case where there are more then one field in data type declaration
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* Add case03 where a type variable is present
* Add case04 - multiple declarations
* Make case04 pass
* Extend tests with case05
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* Add pending case06
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* Fix case 06
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* Add case07
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* Add second phantom case
* Add records to config
* Make indent size configurable for records
Co-authored-by: Paweł Szulc <paul.szulc@gmail.com>
* Fix warnings in Data.hs
* Process derivings during record formatting
Co-authored-by: Paweł Szulc <paul.szulc@gmail.com>
* Do not format when context is present
Co-authored-by: Paweł Szulc <paul.szulc@gmail.com>
* Add case 11 - deriving with DerivingStrategies
* Bugfix: do not remove empty data declarations
Co-authored-by: Paweł Szulc <paul.szulc@gmail.com>
* Update README example with ability to format records
* Add case12 (Point)
* Fix case 12
* Factor out processName
* Apply hlint suggestions
* Extract constructors helper function
* Make 'indent' global
* Remove unused Stylish.records method
* Fix Config formatting in Config.hs
* Extract processConstructor function
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* Refactor datas function
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* Include comments with AST. Two tests are still failing...
* Fix cases 15 and 16
* Do not format records when comments within
Co-authored-by: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com>
* Clean-up Data.hs
* Refactor Data.hs
Co-authored-by: Pawel Szulc <paul.szulc@gmail.com>
-rw-r--r-- | README.markdown | 5 | ||||
-rw-r--r-- | data/stylish-haskell.yaml | 6 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Config.hs | 9 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/Data.hs | 66 | ||||
-rw-r--r-- | stylish-haskell.cabal | 3 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Config/Tests.hs | 2 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 368 | ||||
-rw-r--r-- | tests/TestSuite.hs | 2 |
8 files changed, 457 insertions, 4 deletions
diff --git a/README.markdown b/README.markdown index 870a40c..54451cc 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: diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 2a17cb5..209d613 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -15,6 +15,9 @@ steps: # # true. # add_language_pragma: true + # Format record definitions + - records: {} + # 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. @@ -222,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 725a465..bd15867 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 @@ -52,6 +53,7 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config { configSteps :: [Step] + , configIndent :: Int , configColumns :: Maybe Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline @@ -119,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) @@ -141,6 +144,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 +184,11 @@ parseSimpleAlign c o = SimpleAlign.step where withDef f k = fromMaybe (f SimpleAlign.defaultConfig) <$> (o A..:? k) +-------------------------------------------------------------------------------- +parseRecords :: Config -> A.Object -> A.Parser Step +parseRecords c _ = Data.step + <$> pure (configIndent c) + -------------------------------------------------------------------------------- parseSquash :: Config -> A.Object -> A.Parser Step diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs new file mode 100644 index 0000000..9acd22b --- /dev/null +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -0,0 +1,66 @@ +module Language.Haskell.Stylish.Step.Data where + +import Data.List (find, 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 _ _ _ _ decls) = decls +datas _ = [] + +type ChangeLine = Change String + +step :: Int -> Step +step indentSize = makeStep "Data" (step' indentSize) + +step' :: Int -> Lines -> Module -> Lines +step' indentSize ls (module', allComments) = applyChanges changes ls + where + datas' = datas $ fmap linesFromSrcSpan module' + changes = datas' >>= maybeToList . changeDecl allComments indentSize + +findComment :: LineBlock -> [Comment] -> Maybe Comment +findComment lb = find commentOnLine + where + commentOnLine (Comment _ (H.SrcSpan _ start _ end _) _) = + blockStart lb == start && blockEnd lb == end + +commentsWithin :: LineBlock -> [Comment] -> [Comment] +commentsWithin lb = filter within + where + 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) + | null $ commentsWithin block allComments = Just $ change block (const $ concat newLines) + | otherwise = Nothing + where + 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 + typeConstructor = "data " <> H.prettyPrint dhead <> " = " + indented = indent indentSize +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 "}"] + where + 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))) = + 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 = [init <> trimLeft (H.prettyPrint decl)] diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 116d889..de12c11 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/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index ebaef54..f8869ce 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -165,6 +165,8 @@ dotStylish = unlines $ , " align: false" , " remove_redundant: true" , " - trailing_whitespace: {}" + , " - records: {}" + , "indent: 2" , "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 new file mode 100644 index 0000000..b152819 --- /dev/null +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -0,0 +1,368 @@ +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 00" case00 + , 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 + , testCase "case 08" case08 + , testCase "case 09" case09 + , 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 + , testCase "case 17" case17 + , testCase "case 18" case18 + ] + +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 + 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 2) 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" + , " }" + ] + +case03 :: Assertion +case03 = expected @=? testStep (step 2) 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" + , " }" + ] + +case04 :: Assertion +case04 = expected @=? testStep (step 2) 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" + , " }" + ] + +case05 :: Assertion +case05 = expected @=? testStep (step 2) 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" + , " }" + ] + +case06 :: Assertion +case06 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo Int String" + ] + expected = input + +case07 :: Assertion +case07 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Phantom a = Phantom" + ] + expected = input + +case08 :: Assertion +case08 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Phantom a =" + , " Phantom" + ] + expected = unlines + [ "module Herp where" + , "" + , "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" + , " }" + ] + +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)" + ] + +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)" + ] + +case12 :: Assertion +case12 = expected @=? testStep (step 4) 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)" + ] + +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" + , " }" + ] + +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" + , " }" + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index b5bec90..a6f51ea 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 |