From 9b36847119f42d215f904fc821579bd7b5d76cf3 Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Wed, 3 Feb 2021 11:57:16 +0100
Subject: [PATCH 01/11] Add new step Signature that will format function
signatures
The step is a NOP still but additional tests were already created
specifing how we anticipate the step to behave. This step is heavily
inspired by https://github.com/input-output-hk/ouroboros-network/blob/bf8579cc2ff2a7bc4ba23150eff659cfd1c6ccca/ouroboros-consensus/docs/StyleGuide.md
---
.../Haskell/Stylish/Step/Signature.hs | 10 ++
stylish-haskell.cabal | 3 +
.../Haskell/Stylish/Step/Signature/Tests.hs | 144 ++++++++++++++++++
tests/TestSuite.hs | 2 +
4 files changed, 159 insertions(+)
create mode 100644 lib/Language/Haskell/Stylish/Step/Signature.hs
create mode 100644 tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
diff --git a/lib/Language/Haskell/Stylish/Step/Signature.hs b/lib/Language/Haskell/Stylish/Step/Signature.hs
new file mode 100644
index 00000000..6b1124ce
--- /dev/null
+++ b/lib/Language/Haskell/Stylish/Step/Signature.hs
@@ -0,0 +1,10 @@
+module Language.Haskell.Stylish.Step.Signature where
+
+import Language.Haskell.Stylish.Step
+
+data Config = Config
+ { maxColumnLength :: Int
+ }
+
+step :: Config -> Step
+step _ = makeStep "Signature" (\ls _ -> ls)
diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal
index 8e870f59..162c9cd1 100644
--- a/stylish-haskell.cabal
+++ b/stylish-haskell.cabal
@@ -37,6 +37,7 @@ Library
Language.Haskell.Stylish.Step.Imports
Language.Haskell.Stylish.Step.ModuleHeader
Language.Haskell.Stylish.Step.LanguagePragmas
+ Language.Haskell.Stylish.Step.Signature
Language.Haskell.Stylish.Step.SimpleAlign
Language.Haskell.Stylish.Step.Squash
Language.Haskell.Stylish.Step.Tabs
@@ -137,6 +138,8 @@ Test-suite stylish-haskell-tests
Language.Haskell.Stylish.Step.ModuleHeader.Tests
Language.Haskell.Stylish.Step.LanguagePragmas
Language.Haskell.Stylish.Step.LanguagePragmas.Tests
+ Language.Haskell.Stylish.Step.Signature
+ Language.Haskell.Stylish.Step.Signature.Tests
Language.Haskell.Stylish.Step.SimpleAlign
Language.Haskell.Stylish.Step.SimpleAlign.Tests
Language.Haskell.Stylish.Step.Squash
diff --git a/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs b/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
new file mode 100644
index 00000000..b2a8edbf
--- /dev/null
+++ b/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Language.Haskell.Stylish.Step.Signature.Tests
+ ( tests
+ ) where
+
+import Language.Haskell.Stylish.Step.Signature
+import Language.Haskell.Stylish.Tests.Util (assertSnippet, testStep)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion, (@=?))
+
+tests :: Test
+tests = testGroup "Language.Haskell.Stylish.Step.Signature.Tests"
+ [ testCase "do not wrap signature if it fits max column length" case00
+ -- , testCase "wrap signature if it does not fit max column length" case01
+ -- , testCase "how it behaves when there is a list of constraints" case02
+ -- , testCase "how it behaves when there is a explicit forall" case03
+ -- , testCase "how it behaves when there is a explicit forall" case04
+ -- , testCase "how it behaves when there is a large function in the argument" case05
+ ]
+
+config :: Int -> Config
+config maxColumnLength = Config
+ { maxColumnLength = maxColumnLength
+ }
+
+case00 :: Assertion
+case00 = expected @=? testStep (step $ config 80) input
+ where
+ input = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar :: a -> b -> a"
+ , "fooBar v _ = v"
+ ]
+ expected = input
+
+case01 :: Assertion
+case01 = expected @=? testStep (step $ config 20) input
+ where
+ input = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar :: a -> b -> a"
+ , "fooBar v _ = v"
+ ]
+ expected = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar ::"
+ , " a"
+ , " -> b"
+ , " -> a"
+ , "fooBar v _ = v"
+ ]
+
+case02 :: Assertion
+case02 = expected @=? testStep (step $ config 20) input
+ where
+ input = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar :: (Eq a, Show b) => a -> b -> a"
+ , "fooBar v _ = v"
+ ]
+ expected = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar ::"
+ , " (Eq a, Show b)"
+ , " => a"
+ , " -> b"
+ , " -> a"
+ , "fooBar v _ = v"
+ ]
+
+case03 :: Assertion
+case03 = expected @=? testStep (step $ config 20) input
+ where
+ input = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar :: forall a . b. (Eq a, Show b) => a -> b -> a"
+ , "fooBar v _ = v"
+ ]
+ expected = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar ::"
+ , " forall a . b."
+ , " (Eq a, Show b)"
+ , " => a"
+ , " -> b"
+ , " -> a"
+ , "fooBar v _ = v"
+ ]
+
+case04 :: Assertion
+case04 = expected @=? testStep (step $ config 20) input
+ where
+ input = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar :: forall a . b. c. (Eq a, Show b, Ord c) => a -> b -> c -> a"
+ , "fooBar v _ _ = v"
+ ]
+ expected = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar ::"
+ , " forall a . b. ("
+ , " Eq a"
+ , " , Show b"
+ , " , Ord c)"
+ , " )"
+ , " => a"
+ , " -> b"
+ , " -> a"
+ , "fooBar v _ = v"
+ ]
+
+case05 :: Assertion
+case05 = expected @=? testStep (step $ config 20) input
+ where
+ input = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar :: => a -> (forall c. Eq c => c -> a -> a) -> a"
+ , "fooBar v _ = v"
+ ]
+ expected = unlines
+ [ "module Herp where"
+ , ""
+ , "fooBar ::"
+ , " => a"
+ , " -> ( forall c. Eq c"
+ , " => c"
+ , " -> a"
+ , " -> a"
+ , " )"
+ , " -> a"
+ , "fooBar v _ = v"
+ ]
diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs
index 501821b2..4c73ddb9 100644
--- a/tests/TestSuite.hs
+++ b/tests/TestSuite.hs
@@ -16,6 +16,7 @@ import qualified Language.Haskell.Stylish.Step.Imports.Tests
import qualified Language.Haskell.Stylish.Step.Imports.FelixTests
import qualified Language.Haskell.Stylish.Step.ModuleHeader.Tests
import qualified Language.Haskell.Stylish.Step.LanguagePragmas.Tests
+import qualified Language.Haskell.Stylish.Step.Signature.Tests
import qualified Language.Haskell.Stylish.Step.SimpleAlign.Tests
import qualified Language.Haskell.Stylish.Step.Squash.Tests
import qualified Language.Haskell.Stylish.Step.Tabs.Tests
@@ -34,6 +35,7 @@ main = defaultMain
, Language.Haskell.Stylish.Step.Imports.FelixTests.tests
, Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests
, Language.Haskell.Stylish.Step.ModuleHeader.Tests.tests
+ , Language.Haskell.Stylish.Step.Signature.Tests.tests
, Language.Haskell.Stylish.Step.SimpleAlign.Tests.tests
, Language.Haskell.Stylish.Step.Squash.Tests.tests
, Language.Haskell.Stylish.Step.Tabs.Tests.tests
From b30c9447584f8930263a8fdfc381694a5b55ce17 Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Fri, 5 Feb 2021 12:51:59 +0100
Subject: [PATCH 02/11] Modify Signature to look top level func signatures and
prepare for formatting
---
.../Haskell/Stylish/Step/Signature.hs | 40 ++++++++++++++++++-
.../Haskell/Stylish/Step/Signature/Tests.hs | 4 +-
2 files changed, 40 insertions(+), 4 deletions(-)
diff --git a/lib/Language/Haskell/Stylish/Step/Signature.hs b/lib/Language/Haskell/Stylish/Step/Signature.hs
index 6b1124ce..b4b067a5 100644
--- a/lib/Language/Haskell/Stylish/Step/Signature.hs
+++ b/lib/Language/Haskell/Stylish/Step/Signature.hs
@@ -1,10 +1,46 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
module Language.Haskell.Stylish.Step.Signature where
+import RdrName (RdrName)
+import SrcLoc (GenLocated (..), Located)
+import GHC.Hs.Decls (HsDecl(..))
+import GHC.Hs.Binds (Sig(..))
+import GHC.Hs.Extension (GhcPs)
+
+--------------------------------------------------------------------------------
+import Language.Haskell.Stylish.Block
import Language.Haskell.Stylish.Step
+import Language.Haskell.Stylish.Module
+import Language.Haskell.Stylish.Editor (change)
+import Language.Haskell.Stylish.GHC (getStartLineUnsafe, getEndLineUnsafe)
+import Language.Haskell.Stylish.Editor (Change, applyChanges)
+
+-- TODO unify with type alias from Data.hs
+type ChangeLine = Change String
data Config = Config
- { maxColumnLength :: Int
+ { cMaxColumns :: Int
}
step :: Config -> Step
-step _ = makeStep "Signature" (\ls _ -> ls)
+step cfg = makeStep "Signature" (\ls m -> applyChanges (changes cfg m) ls)
+
+changes :: Config -> Module -> [ChangeLine]
+changes cfg m = fmap (formatSignatureDecl cfg m) (topLevelFunctionSignatures m)
+
+topLevelFunctionSignatures :: Module -> [Located SignatureDecl]
+topLevelFunctionSignatures = queryModule @(Located (HsDecl GhcPs)) \case
+ L pos (SigD _ (TypeSig _ [name] _)) -> [L pos $ MkSignatureDecl name]
+ _ -> []
+
+data SignatureDecl = MkSignatureDecl
+ { sigName :: Located RdrName
+ }
+
+formatSignatureDecl :: Config -> Module -> Located SignatureDecl -> ChangeLine
+formatSignatureDecl _cfg _m ldecl = change originalDeclBlock id
+ where
+ originalDeclBlock =
+ Block (getStartLineUnsafe ldecl) (getEndLineUnsafe ldecl)
diff --git a/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs b/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
index b2a8edbf..267c6ea0 100644
--- a/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
@@ -21,8 +21,8 @@ tests = testGroup "Language.Haskell.Stylish.Step.Signature.Tests"
]
config :: Int -> Config
-config maxColumnLength = Config
- { maxColumnLength = maxColumnLength
+config cMaxColumns = Config
+ { cMaxColumns = cMaxColumns
}
case00 :: Assertion
From d66228d1bc512bbe41160c7e0681c3716561605d Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Thu, 18 Feb 2021 12:28:06 +0100
Subject: [PATCH 03/11] Add noop change function
---
lib/Language/Haskell/Stylish/Editor.hs | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/lib/Language/Haskell/Stylish/Editor.hs b/lib/Language/Haskell/Stylish/Editor.hs
index f71d1f6d..51fa533d 100644
--- a/lib/Language/Haskell/Stylish/Editor.hs
+++ b/lib/Language/Haskell/Stylish/Editor.hs
@@ -17,6 +17,7 @@ module Language.Haskell.Stylish.Editor
, delete
, deleteLine
, insert
+ , noop
) where
@@ -84,6 +85,9 @@ applyChanges changes0
change :: Block a -> ([a] -> [a]) -> Change a
change = Change
+--------------------------------------------------------------------------------
+noop :: Block a -> Change a
+noop = flip change $ id
--------------------------------------------------------------------------------
-- | Change a single line for some other lines
From 0bd98512461cdf8e548e4c6783aafbc4d34dbcc2 Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Thu, 18 Feb 2021 12:29:12 +0100
Subject: [PATCH 04/11] Add getEndColumnUnsafe for a given Located element
---
lib/Language/Haskell/Stylish/GHC.hs | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/lib/Language/Haskell/Stylish/GHC.hs b/lib/Language/Haskell/Stylish/GHC.hs
index c99d4bf6..bb9bc4f4 100644
--- a/lib/Language/Haskell/Stylish/GHC.hs
+++ b/lib/Language/Haskell/Stylish/GHC.hs
@@ -8,6 +8,7 @@ module Language.Haskell.Stylish.GHC
-- * Unsafe getters
, unsafeGetRealSrcSpan
, getEndLineUnsafe
+ , getEndColumnUnsafe
, getStartLineUnsafe
-- * Standard settings
, baseDynFlags
@@ -33,7 +34,7 @@ import qualified Outputable as GHC
import PlatformConstants (PlatformConstants (..))
import SrcLoc (GenLocated (..), Located, RealLocated,
RealSrcSpan, SrcSpan (..), srcSpanEndLine,
- srcSpanStartLine)
+ srcSpanStartLine, srcSpanEndCol)
import ToolSettings (ToolSettings (..))
unsafeGetRealSrcSpan :: Located a -> RealSrcSpan
@@ -47,6 +48,9 @@ getStartLineUnsafe = srcSpanStartLine . unsafeGetRealSrcSpan
getEndLineUnsafe :: Located a -> Int
getEndLineUnsafe = srcSpanEndLine . unsafeGetRealSrcSpan
+getEndColumnUnsafe :: Located a -> Int
+getEndColumnUnsafe = srcSpanEndCol . unsafeGetRealSrcSpan
+
dropAfterLocated :: Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
dropAfterLocated loc xs = case loc of
Just (L (RealSrcSpan rloc) _) ->
From 53f6d6c90a950c55d3457684c795ddc30f4fee89 Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Thu, 18 Feb 2021 12:29:42 +0100
Subject: [PATCH 05/11] Implement test case 'wrap signature if it does not fit
max column length'
---
.../Haskell/Stylish/Step/Signature.hs | 51 ++++++++++++++++---
.../Haskell/Stylish/Step/Signature/Tests.hs | 4 +-
2 files changed, 46 insertions(+), 9 deletions(-)
diff --git a/lib/Language/Haskell/Stylish/Step/Signature.hs b/lib/Language/Haskell/Stylish/Step/Signature.hs
index b4b067a5..10c5e875 100644
--- a/lib/Language/Haskell/Stylish/Step/Signature.hs
+++ b/lib/Language/Haskell/Stylish/Step/Signature.hs
@@ -1,27 +1,39 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE RecordWildCards #-}
module Language.Haskell.Stylish.Step.Signature where
import RdrName (RdrName)
import SrcLoc (GenLocated (..), Located)
-import GHC.Hs.Decls (HsDecl(..))
-import GHC.Hs.Binds (Sig(..))
+import GHC.Hs.Decls
+import GHC.Hs.Binds
+import GHC.Hs.Types
import GHC.Hs.Extension (GhcPs)
--------------------------------------------------------------------------------
import Language.Haskell.Stylish.Block
import Language.Haskell.Stylish.Step
import Language.Haskell.Stylish.Module
-import Language.Haskell.Stylish.Editor (change)
-import Language.Haskell.Stylish.GHC (getStartLineUnsafe, getEndLineUnsafe)
+import Language.Haskell.Stylish.Editor (change, noop)
+import Language.Haskell.Stylish.GHC (getStartLineUnsafe, getEndLineUnsafe, getEndColumnUnsafe)
import Language.Haskell.Stylish.Editor (Change, applyChanges)
+import Language.Haskell.Stylish.Printer
-- TODO unify with type alias from Data.hs
type ChangeLine = Change String
+data MaxColumns
+ = MaxColumns !Int
+ | NoMaxColumns
+ deriving (Show, Eq)
+
+fits :: Int -> MaxColumns -> Bool
+fits _ NoMaxColumns = True
+fits v (MaxColumns limit) = v <= limit
+
data Config = Config
- { cMaxColumns :: Int
+ { cMaxColumns :: MaxColumns
}
step :: Config -> Step
@@ -32,15 +44,40 @@ changes cfg m = fmap (formatSignatureDecl cfg m) (topLevelFunctionSignatures m)
topLevelFunctionSignatures :: Module -> [Located SignatureDecl]
topLevelFunctionSignatures = queryModule @(Located (HsDecl GhcPs)) \case
- L pos (SigD _ (TypeSig _ [name] _)) -> [L pos $ MkSignatureDecl name]
+ L pos (SigD _ (TypeSig _ [name] (HsWC _ (HsIB _ (L _ funTy@(HsFunTy _ _ _ )))))) ->
+ [L pos $ MkSignatureDecl name (listParameters funTy)]
_ -> []
+listParameters :: HsType GhcPs -> [Located RdrName]
+listParameters (HsFunTy _ (L _ arg2) (L _ arg3)) = listParameters arg2 <> listParameters arg3
+listParameters (HsTyVar _ _promotionFlag name) = [name]
+listParameters _ = []
+
data SignatureDecl = MkSignatureDecl
{ sigName :: Located RdrName
+ , sigParameters :: [Located RdrName]
}
formatSignatureDecl :: Config -> Module -> Located SignatureDecl -> ChangeLine
-formatSignatureDecl _cfg _m ldecl = change originalDeclBlock id
+formatSignatureDecl Config{..} m ldecl@(L _declPos decl) = do
+ let block = originalDeclBlock
+ declLength = getEndColumnUnsafe ldecl
+ if fits declLength cMaxColumns then
+ noop block
+ else
+ change block (const printDecl)
+
where
originalDeclBlock =
Block (getStartLineUnsafe ldecl) (getEndLineUnsafe ldecl)
+
+ printerConfig = PrinterConfig
+ { columns = case cMaxColumns of
+ NoMaxColumns -> Nothing
+ MaxColumns n -> Just n
+ }
+
+ printDecl = runPrinter_ printerConfig [] m do
+ (putRdrName $ sigName decl) >> space >> putText "::" >> newline
+ spaces 5 >> (putRdrName $ head $ sigParameters decl) >> newline
+ traverse (\para -> spaces 2 >> putText "->" >> space >> (putRdrName para) >> newline) (tail $ sigParameters decl)
diff --git a/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs b/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
index 267c6ea0..b1ed6c87 100644
--- a/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
@@ -13,7 +13,7 @@ import Test.HUnit (Assertion, (@=?))
tests :: Test
tests = testGroup "Language.Haskell.Stylish.Step.Signature.Tests"
[ testCase "do not wrap signature if it fits max column length" case00
- -- , testCase "wrap signature if it does not fit max column length" case01
+ , testCase "wrap signature if it does not fit max column length" case01
-- , testCase "how it behaves when there is a list of constraints" case02
-- , testCase "how it behaves when there is a explicit forall" case03
-- , testCase "how it behaves when there is a explicit forall" case04
@@ -22,7 +22,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Signature.Tests"
config :: Int -> Config
config cMaxColumns = Config
- { cMaxColumns = cMaxColumns
+ { cMaxColumns = MaxColumns cMaxColumns
}
case00 :: Assertion
From 0497835a63b5dda7a92fd70f44794310cff4a0cc Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Thu, 18 Feb 2021 21:12:13 +0100
Subject: [PATCH 06/11] Extract printDecl to separate toplevel function
---
lib/Language/Haskell/Stylish/Step/Signature.hs | 15 ++++++++-------
1 file changed, 8 insertions(+), 7 deletions(-)
diff --git a/lib/Language/Haskell/Stylish/Step/Signature.hs b/lib/Language/Haskell/Stylish/Step/Signature.hs
index 10c5e875..13cb0108 100644
--- a/lib/Language/Haskell/Stylish/Step/Signature.hs
+++ b/lib/Language/Haskell/Stylish/Step/Signature.hs
@@ -59,25 +59,26 @@ data SignatureDecl = MkSignatureDecl
}
formatSignatureDecl :: Config -> Module -> Located SignatureDecl -> ChangeLine
-formatSignatureDecl Config{..} m ldecl@(L _declPos decl) = do
+formatSignatureDecl cfg@Config{..} m ldecl = do
let block = originalDeclBlock
declLength = getEndColumnUnsafe ldecl
if fits declLength cMaxColumns then
noop block
else
- change block (const printDecl)
+ change block (const (printDecl cfg m ldecl))
where
originalDeclBlock =
Block (getStartLineUnsafe ldecl) (getEndLineUnsafe ldecl)
+printDecl :: Config -> Module -> Located SignatureDecl -> Lines
+printDecl Config{..} m ldecl@(L _declPos decl) = runPrinter_ printerConfig [] m do
+ (putRdrName $ sigName decl) >> space >> putText "::" >> newline
+ spaces 5 >> (putRdrName $ head $ sigParameters decl) >> newline
+ traverse (\para -> spaces 2 >> putText "->" >> space >> (putRdrName para) >> newline) (tail $ sigParameters decl)
+ where
printerConfig = PrinterConfig
{ columns = case cMaxColumns of
NoMaxColumns -> Nothing
MaxColumns n -> Just n
}
-
- printDecl = runPrinter_ printerConfig [] m do
- (putRdrName $ sigName decl) >> space >> putText "::" >> newline
- spaces 5 >> (putRdrName $ head $ sigParameters decl) >> newline
- traverse (\para -> spaces 2 >> putText "->" >> space >> (putRdrName para) >> newline) (tail $ sigParameters decl)
From d9ccfdb32351b15b1de12fe967346e13d42b586d Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Thu, 18 Feb 2021 21:16:36 +0100
Subject: [PATCH 07/11] Extract helper printing functions
---
lib/Language/Haskell/Stylish/Step/Signature.hs | 18 ++++++++++++++----
1 file changed, 14 insertions(+), 4 deletions(-)
diff --git a/lib/Language/Haskell/Stylish/Step/Signature.hs b/lib/Language/Haskell/Stylish/Step/Signature.hs
index 13cb0108..ed4b273c 100644
--- a/lib/Language/Haskell/Stylish/Step/Signature.hs
+++ b/lib/Language/Haskell/Stylish/Step/Signature.hs
@@ -72,11 +72,21 @@ formatSignatureDecl cfg@Config{..} m ldecl = do
Block (getStartLineUnsafe ldecl) (getEndLineUnsafe ldecl)
printDecl :: Config -> Module -> Located SignatureDecl -> Lines
-printDecl Config{..} m ldecl@(L _declPos decl) = runPrinter_ printerConfig [] m do
- (putRdrName $ sigName decl) >> space >> putText "::" >> newline
- spaces 5 >> (putRdrName $ head $ sigParameters decl) >> newline
- traverse (\para -> spaces 2 >> putText "->" >> space >> (putRdrName para) >> newline) (tail $ sigParameters decl)
+printDecl Config{..} m (L _declPos decl) = runPrinter_ printerConfig [] m do
+ printFirstLine
+ printSecondLine
+ printRemainingLines
where
+
+ printFirstLine =
+ (putRdrName $ sigName decl) >> space >> putText "::" >> newline
+
+ printSecondLine =
+ spaces 5 >> (putRdrName $ head $ sigParameters decl) >> newline
+
+ printRemainingLines =
+ traverse (\para -> spaces 2 >> putText "->" >> space >> (putRdrName para) >> newline) (tail $ sigParameters decl)
+
printerConfig = PrinterConfig
{ columns = case cMaxColumns of
NoMaxColumns -> Nothing
From ce99839a0b7e583135d177f7e6eb0d1de3341379 Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Thu, 18 Feb 2021 21:20:25 +0100
Subject: [PATCH 08/11] Simplify formatSignatureDecl
---
lib/Language/Haskell/Stylish/Step/Signature.hs | 14 +++++---------
1 file changed, 5 insertions(+), 9 deletions(-)
diff --git a/lib/Language/Haskell/Stylish/Step/Signature.hs b/lib/Language/Haskell/Stylish/Step/Signature.hs
index ed4b273c..46886b47 100644
--- a/lib/Language/Haskell/Stylish/Step/Signature.hs
+++ b/lib/Language/Haskell/Stylish/Step/Signature.hs
@@ -59,17 +59,13 @@ data SignatureDecl = MkSignatureDecl
}
formatSignatureDecl :: Config -> Module -> Located SignatureDecl -> ChangeLine
-formatSignatureDecl cfg@Config{..} m ldecl = do
- let block = originalDeclBlock
- declLength = getEndColumnUnsafe ldecl
- if fits declLength cMaxColumns then
- noop block
- else
- change block (const (printDecl cfg m ldecl))
+formatSignatureDecl cfg@Config{..} m ldecl
+ | fits declLength cMaxColumns = noop block
+ | otherwise = change block (const (printDecl cfg m ldecl))
where
- originalDeclBlock =
- Block (getStartLineUnsafe ldecl) (getEndLineUnsafe ldecl)
+ block = Block (getStartLineUnsafe ldecl) (getEndLineUnsafe ldecl)
+ declLength = getEndColumnUnsafe ldecl
printDecl :: Config -> Module -> Located SignatureDecl -> Lines
printDecl Config{..} m (L _declPos decl) = runPrinter_ printerConfig [] m do
From f331870f7253b4512388df072d42929a178b61cb Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Thu, 18 Feb 2021 21:47:33 +0100
Subject: [PATCH 09/11] Simplify access to SignatureDecl inside printDecl
---
lib/Language/Haskell/Stylish/Step/Signature.hs | 14 +++++++-------
1 file changed, 7 insertions(+), 7 deletions(-)
diff --git a/lib/Language/Haskell/Stylish/Step/Signature.hs b/lib/Language/Haskell/Stylish/Step/Signature.hs
index 46886b47..f6005573 100644
--- a/lib/Language/Haskell/Stylish/Step/Signature.hs
+++ b/lib/Language/Haskell/Stylish/Step/Signature.hs
@@ -59,29 +59,29 @@ data SignatureDecl = MkSignatureDecl
}
formatSignatureDecl :: Config -> Module -> Located SignatureDecl -> ChangeLine
-formatSignatureDecl cfg@Config{..} m ldecl
+formatSignatureDecl cfg@Config{..} m ldecl@(L _ decl)
| fits declLength cMaxColumns = noop block
- | otherwise = change block (const (printDecl cfg m ldecl))
+ | otherwise = change block (const (printDecl cfg m decl))
where
block = Block (getStartLineUnsafe ldecl) (getEndLineUnsafe ldecl)
declLength = getEndColumnUnsafe ldecl
-printDecl :: Config -> Module -> Located SignatureDecl -> Lines
-printDecl Config{..} m (L _declPos decl) = runPrinter_ printerConfig [] m do
+printDecl :: Config -> Module -> SignatureDecl -> Lines
+printDecl Config{..} m MkSignatureDecl{..} = runPrinter_ printerConfig [] m do
printFirstLine
printSecondLine
printRemainingLines
where
printFirstLine =
- (putRdrName $ sigName decl) >> space >> putText "::" >> newline
+ putRdrName sigName >> space >> putText "::" >> newline
printSecondLine =
- spaces 5 >> (putRdrName $ head $ sigParameters decl) >> newline
+ spaces 5 >> (putRdrName $ head sigParameters) >> newline
printRemainingLines =
- traverse (\para -> spaces 2 >> putText "->" >> space >> (putRdrName para) >> newline) (tail $ sigParameters decl)
+ traverse (\para -> spaces 2 >> putText "->" >> space >> (putRdrName para) >> newline) (tail $ sigParameters)
printerConfig = PrinterConfig
{ columns = case cMaxColumns of
From 63e3bbfcd448ef3448cb3080966b74da2edb5682 Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Thu, 18 Feb 2021 21:49:22 +0100
Subject: [PATCH 10/11] Extract printRemainingLine function
---
lib/Language/Haskell/Stylish/Step/Signature.hs | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/lib/Language/Haskell/Stylish/Step/Signature.hs b/lib/Language/Haskell/Stylish/Step/Signature.hs
index f6005573..b5d3d3f6 100644
--- a/lib/Language/Haskell/Stylish/Step/Signature.hs
+++ b/lib/Language/Haskell/Stylish/Step/Signature.hs
@@ -81,7 +81,10 @@ printDecl Config{..} m MkSignatureDecl{..} = runPrinter_ printerConfig [] m do
spaces 5 >> (putRdrName $ head sigParameters) >> newline
printRemainingLines =
- traverse (\para -> spaces 2 >> putText "->" >> space >> (putRdrName para) >> newline) (tail $ sigParameters)
+ traverse printRemainingLine (tail sigParameters)
+
+ printRemainingLine parameter =
+ spaces 2 >> putText "->" >> space >> (putRdrName parameter) >> newline
printerConfig = PrinterConfig
{ columns = case cMaxColumns of
From 41ca2df3a0f53a3591d9d640749606228717d656 Mon Sep 17 00:00:00 2001
From: EncodePanda <paul.szulc@gmail.com>
Date: Fri, 19 Feb 2021 11:26:50 +0100
Subject: [PATCH 11/11] Implement "how it behaves when there is a list of
constraints"
---
.../Haskell/Stylish/Step/Signature.hs | 52 +++++++++++++++++--
.../Haskell/Stylish/Step/Signature/Tests.hs | 2 +-
2 files changed, 48 insertions(+), 6 deletions(-)
diff --git a/lib/Language/Haskell/Stylish/Step/Signature.hs b/lib/Language/Haskell/Stylish/Step/Signature.hs
index b5d3d3f6..3b2b45cd 100644
--- a/lib/Language/Haskell/Stylish/Step/Signature.hs
+++ b/lib/Language/Haskell/Stylish/Step/Signature.hs
@@ -45,7 +45,9 @@ changes cfg m = fmap (formatSignatureDecl cfg m) (topLevelFunctionSignatures m)
topLevelFunctionSignatures :: Module -> [Located SignatureDecl]
topLevelFunctionSignatures = queryModule @(Located (HsDecl GhcPs)) \case
L pos (SigD _ (TypeSig _ [name] (HsWC _ (HsIB _ (L _ funTy@(HsFunTy _ _ _ )))))) ->
- [L pos $ MkSignatureDecl name (listParameters funTy)]
+ [L pos $ MkSignatureDecl name (listParameters funTy) []]
+ L pos (SigD _ (TypeSig _ [name] (HsWC _ (HsIB _ (L _ (HsQualTy _ (L _ contexts) (L _ funTy))))))) ->
+ [L pos $ MkSignatureDecl name (listParameters funTy) (contexts >>= listContexts)]
_ -> []
listParameters :: HsType GhcPs -> [Located RdrName]
@@ -53,9 +55,15 @@ listParameters (HsFunTy _ (L _ arg2) (L _ arg3)) = listParameters arg2 <> listPa
listParameters (HsTyVar _ _promotionFlag name) = [name]
listParameters _ = []
+listContexts :: Located (HsType GhcPs) -> [Located RdrName]
+listContexts (L _ (HsTyVar _ _ name)) = [name]
+listContexts (L _ (HsAppTy _ arg1 arg2)) = listContexts arg1 <> listContexts arg2
+listContexts _ = []
+
data SignatureDecl = MkSignatureDecl
{ sigName :: Located RdrName
, sigParameters :: [Located RdrName]
+ , sigConstraints :: [Located RdrName]
}
formatSignatureDecl :: Config -> Module -> Located SignatureDecl -> ChangeLine
@@ -74,20 +82,54 @@ printDecl Config{..} m MkSignatureDecl{..} = runPrinter_ printerConfig [] m do
printRemainingLines
where
+ ----------------------------------------------------------------------------------------
+
printFirstLine =
putRdrName sigName >> space >> putText "::" >> newline
+ ----------------------------------------------------------------------------------------
+
printSecondLine =
- spaces 5 >> (putRdrName $ head sigParameters) >> newline
+ if hasConstraints then printConstraints
+ else printFirstParameter
+
+ printConstraints =
+ spaces 5 >> putText "("
+ >> (traverse (\ctr -> printConstraint ctr >> putText ", ") (init groupConstraints))
+ >> (printConstraint $ last groupConstraints)
+ >> putText ")" >> newline
+
+ groupConstraints = zip (dropEvery sigConstraints 2) (dropEvery (tail sigConstraints) 2)
+
+ printConstraint (tc, tp) = putRdrName tc >> space >> putRdrName tp
+
+ printFirstParameter =
+ spaces 5 >> (putRdrName $ head sigParameters) >> newline
+
+ ----------------------------------------------------------------------------------------
printRemainingLines =
- traverse printRemainingLine (tail sigParameters)
+ if hasConstraints then
+ printRemainingLine "=>" (head sigParameters)
+ >> traverse (printRemainingLine "->") (tail sigParameters)
+ else
+ traverse (printRemainingLine "->") (tail sigParameters)
+
+ printRemainingLine prefix parameter =
+ spaces 2 >> putText prefix >> space >> (putRdrName parameter) >> newline
- printRemainingLine parameter =
- spaces 2 >> putText "->" >> space >> (putRdrName parameter) >> newline
+ ----------------------------------------------------------------------------------------
printerConfig = PrinterConfig
{ columns = case cMaxColumns of
NoMaxColumns -> Nothing
MaxColumns n -> Just n
}
+
+ hasConstraints = not $ null sigConstraints
+
+-- 99 problems :)
+dropEvery :: [a] -> Int -> [a]
+dropEvery xs n
+ | length xs < n = xs
+ | otherwise = take (n-1) xs ++ dropEvery (drop n xs) n
diff --git a/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs b/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
index b1ed6c87..370efced 100644
--- a/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Step/Signature/Tests.hs
@@ -14,7 +14,7 @@ tests :: Test
tests = testGroup "Language.Haskell.Stylish.Step.Signature.Tests"
[ testCase "do not wrap signature if it fits max column length" case00
, testCase "wrap signature if it does not fit max column length" case01
- -- , testCase "how it behaves when there is a list of constraints" case02
+ , testCase "how it behaves when there is a list of constraints" case02
-- , testCase "how it behaves when there is a explicit forall" case03
-- , testCase "how it behaves when there is a explicit forall" case04
-- , testCase "how it behaves when there is a large function in the argument" case05