diff options
author | Jasper Van der Jeugt <m@jaspervdj.be> | 2016-07-03 14:51:41 +0200 |
---|---|---|
committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2016-07-03 18:15:57 +0200 |
commit | f2f6c3e9636e7a03d2b5f81b9afa1453e8a0976e (patch) | |
tree | 04e28c3badcf5188e1de81b8168207e9b7c9b1b2 | |
parent | d56edbd043ac3d6f67d9f8cdf54b2c826f6da2e2 (diff) | |
download | stylish-haskell-f2f6c3e9636e7a03d2b5f81b9afa1453e8a0976e.tar.gz |
Add alignment for some case expressions
-rw-r--r-- | data/stylish-haskell.yaml | 5 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish.hs | 8 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Config.hs | 9 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/Cases.hs | 46 | ||||
-rw-r--r-- | stylish-haskell.cabal | 2 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Cases/Tests.hs | 39 | ||||
-rw-r--r-- | tests/TestSuite.hs | 2 |
7 files changed, 110 insertions, 1 deletions
diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index fb12606..1c04b3d 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -15,6 +15,11 @@ steps: # # true. # add_language_pragma: true + # Align the right hand side of case statements. This is quite conservative + # and only applies to case statements where each alternative occupies a single + # line. + - cases: {} + # Import cleanup - imports: # There are different ways we can align names and lists. diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index cfc7807..6e54d65 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -3,6 +3,7 @@ module Language.Haskell.Stylish ( -- * Run runSteps -- * Steps + , cases , imports , languagePragmas , records @@ -32,6 +33,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.Cases as Cases import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas import qualified Language.Haskell.Stylish.Step.Records as Records @@ -43,6 +45,12 @@ import Paths_stylish_haskell (version) -------------------------------------------------------------------------------- +cases :: Int -- ^ Columns + -> Step +cases = Cases.step + + +-------------------------------------------------------------------------------- imports :: Int -- ^ columns -> Imports.Align -> Step diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 2f72958..7994216 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -28,6 +28,7 @@ import System.FilePath (joinPath, -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Step +import qualified Language.Haskell.Stylish.Step.Cases as Cases import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas import qualified Language.Haskell.Stylish.Step.Records as Records @@ -126,7 +127,8 @@ parseConfig _ = mzero -------------------------------------------------------------------------------- catalog :: Map String (Config -> A.Object -> A.Parser Step) catalog = M.fromList - [ ("imports", parseImports) + [ ("cases", parseCases) + , ("imports", parseImports) , ("language_pragmas", parseLanguagePragmas) , ("records", parseRecords) , ("tabs", parseTabs) @@ -155,6 +157,11 @@ parseEnum strs _ (Just k) = case lookup k strs of -------------------------------------------------------------------------------- +parseCases :: Config -> A.Object -> A.Parser Step +parseCases c _ = return (Cases.step $ configColumns c) + + +-------------------------------------------------------------------------------- parseImports :: Config -> A.Object -> A.Parser Step parseImports config o = Imports.step <$> pure (configColumns config) diff --git a/lib/Language/Haskell/Stylish/Step/Cases.hs b/lib/Language/Haskell/Stylish/Step/Cases.hs new file mode 100644 index 0000000..e71c6c9 --- /dev/null +++ b/lib/Language/Haskell/Stylish/Step/Cases.hs @@ -0,0 +1,46 @@ +-------------------------------------------------------------------------------- +module Language.Haskell.Stylish.Step.Cases + ( step + ) where + + +-------------------------------------------------------------------------------- +import Data.Data (Data) +import Data.Maybe (maybeToList) +import qualified Language.Haskell.Exts.Annotated as H + + +-------------------------------------------------------------------------------- +import Language.Haskell.Stylish.Align +import Language.Haskell.Stylish.Editor +import Language.Haskell.Stylish.Step +import Language.Haskell.Stylish.Util + + +-------------------------------------------------------------------------------- +cases :: Data l => H.Module l -> [[H.Alt l]] +cases modu = [alts | H.Case _ _ alts <- everything modu] + + +-------------------------------------------------------------------------------- +altToAlignable :: H.Alt l -> Maybe (Alignable l) +altToAlignable (H.Alt _ _ _ (Just _)) = Nothing +altToAlignable (H.Alt ann pat rhs Nothing) = Just $ Alignable + { aContainer = ann + , aLeft = H.ann pat + , aRight = H.ann rhs + , aRightLead = length "-> " + } + + +-------------------------------------------------------------------------------- +step :: Int -> Step +step maxColumns = makeStep "Cases" $ \ls (module', _) -> + let module'' = fmap H.srcInfoSpan module' in + applyChanges + [ change_ + | case_ <- cases module'' + , aligns <- maybeToList (mapM altToAlignable case_) + , change_ <- align maxColumns aligns + ] + ls diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 5db9a1d..f945264 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -36,6 +36,7 @@ Library Language.Haskell.Stylish.Editor Language.Haskell.Stylish.Parse Language.Haskell.Stylish.Step + Language.Haskell.Stylish.Step.Cases Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.LanguagePragmas Language.Haskell.Stylish.Step.Records @@ -93,6 +94,7 @@ Test-suite stylish-haskell-tests Language.Haskell.Stylish.Parse Language.Haskell.Stylish.Parse.Tests Language.Haskell.Stylish.Step + Language.Haskell.Stylish.Step.Cases Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.Imports.Tests Language.Haskell.Stylish.Step.LanguagePragmas diff --git a/tests/Language/Haskell/Stylish/Step/Cases/Tests.hs b/tests/Language/Haskell/Stylish/Step/Cases/Tests.hs new file mode 100644 index 0000000..cab671e --- /dev/null +++ b/tests/Language/Haskell/Stylish/Step/Cases/Tests.hs @@ -0,0 +1,39 @@ +-------------------------------------------------------------------------------- +module Language.Haskell.Stylish.Step.Cases.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, (@=?)) + + +-------------------------------------------------------------------------------- +import Language.Haskell.Stylish.Step.Cases +import Language.Haskell.Stylish.Tests.Util + + +-------------------------------------------------------------------------------- +tests :: Test +tests = testGroup "Language.Haskell.Stylish.Step.Records.Tests" + [ testCase "case 01" case01 + ] + + +-------------------------------------------------------------------------------- +case01 :: Assertion +case01 = expected @=? testStep (step 80) input + where + input = unlines + [ "eitherToMaybe e = case e of" + , " Left _ -> Nothing" + , " Right x -> Just x" + ] + + expected = unlines + [ "eitherToMaybe e = case e of" + , " Left _ -> Nothing" + , " Right x -> Just x" + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index 28c0603..27f9851 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -10,6 +10,7 @@ import Test.Framework (defaultMain) -------------------------------------------------------------------------------- import qualified Language.Haskell.Stylish.Parse.Tests +import qualified Language.Haskell.Stylish.Step.Cases.Tests import qualified Language.Haskell.Stylish.Step.Imports.Tests import qualified Language.Haskell.Stylish.Step.LanguagePragmas.Tests import qualified Language.Haskell.Stylish.Step.Records.Tests @@ -22,6 +23,7 @@ import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests main :: IO () main = defaultMain [ Language.Haskell.Stylish.Parse.Tests.tests + , Language.Haskell.Stylish.Step.Cases.Tests.tests , Language.Haskell.Stylish.Step.Imports.Tests.tests , Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests , Language.Haskell.Stylish.Step.Records.Tests.tests |