stylish-haskell 0.3.2.0 → 0.4.0.0

raw patch · 10 files changed

+203/−47 lines, 10 filesdep ~cmdargs

Dependency ranges changed: cmdargs

Files

• .stylish-haskell.yaml +3/−0
• src/StylishHaskell/Config.hs +8/−1
• src/StylishHaskell/Editor.hs +17/−20
• src/StylishHaskell/Step/Imports.hs +1/−1
• src/StylishHaskell/Step/Records.hs +71/−0
• src/StylishHaskell/Step/UnicodeSyntax.hs +10/−22
• stylish-haskell.cabal +6/−3
• tests/StylishHaskell/Parse/Tests.hs +44/−0
• tests/StylishHaskell/Step/Records/Tests.hs +41/−0
• tests/TestSuite.hs +2/−0

@@ -45,6 +45,9 @@       # is set to true, it will remove those redundant pragmas. Default: true.       remove_redundant: true +  # Align the types in record declarations+  - records: {}+   # Replace tabs by spaces. This is disabled by default.   # - tabs:   #     # Number of spaces to use for each tab. Default: 8, as specified by the

@@ -12,7 +12,7 @@ -------------------------------------------------------------------------------- import           Control.Applicative                    (pure, (<$>), (<*>)) import           Control.Monad                          (forM, msum, mzero)-import           Data.Aeson                             (FromJSON(..))+import           Data.Aeson                             (FromJSON (..)) import qualified Data.Aeson                             as A import qualified Data.Aeson.Types                       as A import qualified Data.ByteString                        as B@@ -29,6 +29,7 @@ import           StylishHaskell.Step import qualified StylishHaskell.Step.Imports            as Imports import qualified StylishHaskell.Step.LanguagePragmas    as LanguagePragmas+import qualified StylishHaskell.Step.Records            as Records import qualified StylishHaskell.Step.Tabs               as Tabs import qualified StylishHaskell.Step.TrailingWhitespace as TrailingWhitespace import qualified StylishHaskell.Step.UnicodeSyntax      as UnicodeSyntax@@ -124,6 +125,7 @@ catalog = M.fromList     [ ("imports",             parseImports)     , ("language_pragmas",    parseLanguagePragmas)+    , ("records",             parseRecords)     , ("tabs",                parseTabs)     , ("trailing_whitespace", parseTrailingWhitespace)     , ("unicode_syntax",      parseUnicodeSyntax)@@ -173,6 +175,11 @@         [ ("vertical", LanguagePragmas.Vertical)         , ("compact",  LanguagePragmas.Compact)         ]+++--------------------------------------------------------------------------------+parseRecords :: Config -> A.Object -> A.Parser Step+parseRecords _ _ = return Records.step   --------------------------------------------------------------------------------

@@ -26,8 +26,8 @@ -- | Changes the lines indicated by the 'Block' into the given 'Lines' data Change a = Change     { changeBlock :: Block a-    , changeLines :: [a]-    } deriving (Eq, Show)+    , changeLines :: ([a] -> [a])+    }   --------------------------------------------------------------------------------@@ -36,12 +36,6 @@   ----------------------------------------------------------------------------------- | Number of additional lines introduced when a change is made.-changeExtraLines :: Change a -> Int-changeExtraLines (Change block ls) = length ls - blockLength block----------------------------------------------------------------------------------- applyChanges :: [Change a] -> [a] -> [a] applyChanges changes     | overlapping blocks = error $@@ -65,31 +59,34 @@         -- > new         -- > (recurse)         ---        let block      = changeBlock ch-            (pre, ls') = splitAt (blockStart block - n) ls-            (_, post)  = splitAt (blockLength block) ls'-            extraLines = changeExtraLines ch-            chs'       = map (moveChange extraLines) chs-            n'         = blockStart block + blockLength block + extraLines-        in pre ++ (changeLines ch) ++ go n' chs' post+        let block       = changeBlock ch+            (pre, ls')  = splitAt (blockStart block - n) ls+            (old, post) = splitAt (blockLength block) ls'+            new         = changeLines ch old+            extraLines  = length new - blockLength block+            chs'        = map (moveChange extraLines) chs+            n'          = blockStart block + blockLength block + extraLines+        in pre ++ new ++ go n' chs' post   -------------------------------------------------------------------------------- -- | Change a block of lines for some other lines-change :: Block a -> [a] -> Change a+change :: Block a -> ([a] -> [a]) -> Change a change = Change   -------------------------------------------------------------------------------- -- | Change a single line for some other lines-changeLine :: Int -> [a] -> Change a-changeLine start = change (Block start start)+changeLine :: Int -> (a -> [a]) -> Change a+changeLine start f = change (Block start start) $ \xs -> case xs of+    []      -> []+    (x : _) -> f x   -------------------------------------------------------------------------------- -- | Delete a block of lines delete :: Block a -> Change a-delete block = Change block []+delete block = Change block $ const []   --------------------------------------------------------------------------------@@ -101,4 +98,4 @@ -------------------------------------------------------------------------------- -- | Insert something /before/ the given lines insert :: Int -> [a] -> Change a-insert start = Change (Block start (start - 1))+insert start = Change (Block start (start - 1)) . const

@@ -165,7 +165,7 @@ -------------------------------------------------------------------------------- step' :: Int -> Align -> Lines -> Module -> Lines step' columns align ls (module', _) = flip applyChanges ls-    [ change block (prettyImportGroup columns align longest importGroup)+    [ change block (const $ prettyImportGroup columns align longest importGroup)     | (block, importGroup) <- groups     ]   where

@@ -0,0 +1,71 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.Records+    ( step+    ) where+++--------------------------------------------------------------------------------+import           Data.Char                       (isSpace)+import           Data.List                       (nub)+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+import           StylishHaskell.Editor+import           StylishHaskell.Step+import           StylishHaskell.Util+++--------------------------------------------------------------------------------+records :: H.Module l -> [[H.FieldDecl l]]+records modu =+    [ fields+    | H.Module _ _ _ _ decls                     <- [modu]+    , H.DataDecl _ _ _ _ cons _                  <- decls+    , H.QualConDecl _ _ _ (H.RecDecl _ _ fields) <- cons+    ]+++--------------------------------------------------------------------------------+-- | Align the type of a field+align :: [(Int, Int)] -> [Change String]+align alignment = map align' alignment+  where+    longest = maximum $ map snd alignment++    align' (line, column) = changeLine line $ \str ->+        let (pre, post) = splitAt column str+        in [padRight longest (trimRight pre) ++ trimLeft post]++    trimLeft  = dropWhile isSpace+    trimRight = reverse . trimLeft . reverse+++--------------------------------------------------------------------------------+-- | Determine alignment of fields+fieldAlignment :: [H.FieldDecl H.SrcSpan] -> [(Int, Int)]+fieldAlignment fields =+    [ (H.srcSpanStartLine ann, H.srcSpanEndColumn ann)+    | H.FieldDecl _ names _ <- fields+    , let ann = H.ann (last names)+    ]+++--------------------------------------------------------------------------------+-- | Checks that all no field of the record appears on more than one line,+-- amonst other things+fixable :: [H.FieldDecl H.SrcSpan] -> Bool+fixable []     = False+fixable fields = all singleLine srcSpans && nonOverlapping srcSpans+  where+    srcSpans          = map H.ann fields+    singleLine s      = H.srcSpanStartLine s == H.srcSpanEndLine s+    nonOverlapping ss = length ss == length (nub $ map H.srcSpanStartLine ss)+++--------------------------------------------------------------------------------+step :: Step+step = makeStep "Records" $ \ls (module', _) ->+    let module''       = fmap H.srcInfoSpan module'+        fixableRecords = filter fixable $ records module''+    in applyChanges (fixableRecords >>= align . fieldAlignment) ls

@@ -30,28 +30,16 @@   ---------------------------------------------------------------------------------replaceAll :: [(Int, [(Int, String)])] -> Lines -> [Change String]-replaceAll positions ls =-    zipWith changeLine' positions $ selectLines (map fst positions) ls-  where-    changeLine' (r, ns) str = changeLine r $ return $ flip applyChanges str-        [ change (Block c ec) repl-        | (c, needle) <- sort ns-        , let ec = c + length needle - 1-        , repl <- maybeToList $ M.lookup needle unicodeReplacements-        ]-------------------------------------------------------------------------------------selectLines :: [Int] -> Lines -> [String]-selectLines = go 1+replaceAll :: [(Int, [(Int, String)])] -> [Change String]+replaceAll = map changeLine'   where-    go _ []      _         = []-    go _ _       []        = []-    go r (x : xs) (l : ls)-        | r == x                    = l : go (r + 1) xs ls-        | otherwise                 = go (r + 1) (x : xs) ls+    changeLine' (r, ns) = changeLine r $ \str -> return $+        flip applyChanges str+            [ change (Block c ec) (const repl)+            | (c, needle) <- sort ns+            , let ec = c + length needle - 1+            , repl <- maybeToList $ M.lookup needle unicodeReplacements+            ]   --------------------------------------------------------------------------------@@ -120,7 +108,7 @@ step' alp ls (module', _) = applyChanges changes ls   where     changes = (if alp then addLanguagePragma "UnicodeSyntax" module' else []) ++-        replaceAll perLine ls+        replaceAll perLine     perLine = sort $ groupPerLine $         typeSigs module' ls ++         contexts module' ls ++

@@ -1,5 +1,5 @@ Name:          stylish-haskell-Version:       0.3.2.0+Version:       0.4.0.0 Synopsis:      Haskell code prettifier Homepage:      https://github.com/jaspervdj/stylish-haskell License:       BSD3@@ -36,6 +36,7 @@     StylishHaskell.Step     StylishHaskell.Step.Imports     StylishHaskell.Step.LanguagePragmas+    StylishHaskell.Step.Records     StylishHaskell.Step.Tabs     StylishHaskell.Step.TrailingWhitespace     StylishHaskell.Step.UnicodeSyntax@@ -46,7 +47,7 @@     aeson            >= 0.6  && < 0.7,     base             >= 4    && < 5,     bytestring       >= 0.9  && < 0.10,-    cmdargs          >= 0.9  && < 0.10,+    cmdargs          >= 0.9  && < 0.11,     containers       >= 0.3  && < 0.6,     directory        >= 1.1  && < 1.2,     filepath         >= 1.1  && < 1.4,@@ -63,8 +64,10 @@   Type:           exitcode-stdio-1.0    Other-modules:+    StylishHaskell.Parse.Tests     StylishHaskell.Step.Imports.Tests     StylishHaskell.Step.LanguagePragmas.Tests+    StylishHaskell.Step.Records.Tests     StylishHaskell.Step.Tabs.Tests     StylishHaskell.Step.TrailingWhitespace.Tests     StylishHaskell.Step.UnicodeSyntax.Tests@@ -78,7 +81,7 @@     aeson            >= 0.6  && < 0.7,     base             >= 4    && < 5,     bytestring       >= 0.9  && < 0.10,-    cmdargs          >= 0.9  && < 0.10,+    cmdargs          >= 0.9  && < 0.11,     containers       >= 0.3  && < 0.6,     directory        >= 1.1  && < 1.2,     filepath         >= 1.1  && < 1.4,

@@ -0,0 +1,44 @@+--------------------------------------------------------------------------------+module StylishHaskell.Parse.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     (Assertion, assert)+++--------------------------------------------------------------------------------+import           StylishHaskell.Parse+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "StylishHaskell.Parse"+    [ testCase "UTF-8 Byte Order Mark" testBom+    , testCase "Extra extensions"      testExtraExtensions+    ]+++--------------------------------------------------------------------------------+testBom :: Assertion+testBom = assert $ isRight $ parseModule [] Nothing input+  where+    input = unlines+        [ '\xfeff' : "foo :: Int"+        , "foo = 3"+        ]+++--------------------------------------------------------------------------------+testExtraExtensions :: Assertion+testExtraExtensions = assert $ isRight $+    parseModule ["TemplateHaskell"] Nothing "$(foo)"+++--------------------------------------------------------------------------------+isRight :: Either a b -> Bool+isRight (Right _) = True+isRight _         = False

@@ -0,0 +1,41 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.Records.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     (Assertion, (@=?))+++--------------------------------------------------------------------------------+import           StylishHaskell.Step.Records+import           StylishHaskell.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "StylishHaskell.Step.Records.Tests"+    [ testCase "case 01" case01+    ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = expected @=? testStep step input+  where+    input = unlines+        [ "data Foo = Foo"+        , "    { foo :: Int"+        , "    , barqux :: String"+        , "    } deriving (Show)"+        ]++    expected = unlines+        [ "data Foo = Foo"+        , "    { foo    :: Int"+        , "    , barqux :: String"+        , "    } deriving (Show)"+        ]

@@ -12,6 +12,7 @@ import qualified StylishHaskell.Parse.Tests import qualified StylishHaskell.Step.Imports.Tests import qualified StylishHaskell.Step.LanguagePragmas.Tests+import qualified StylishHaskell.Step.Records.Tests import qualified StylishHaskell.Step.Tabs.Tests import qualified StylishHaskell.Step.TrailingWhitespace.Tests import qualified StylishHaskell.Step.UnicodeSyntax.Tests@@ -23,6 +24,7 @@     [ StylishHaskell.Parse.Tests.tests     , StylishHaskell.Step.Imports.Tests.tests     , StylishHaskell.Step.LanguagePragmas.Tests.tests+    , StylishHaskell.Step.Records.Tests.tests     , StylishHaskell.Step.Tabs.Tests.tests     , StylishHaskell.Step.TrailingWhitespace.Tests.tests     , StylishHaskell.Step.UnicodeSyntax.Tests.tests