From ce59999b3d5e113ca4045fe9c86959beed4415ec Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 3 Dec 2012 17:09:23 +0100 Subject: Make groupAdjacent a bit more abstract --- src/Language/Haskell/Stylish/Block.hs | 13 +++++++++++++ src/Language/Haskell/Stylish/Step/Imports.hs | 16 +--------------- 2 files changed, 14 insertions(+), 15 deletions(-) (limited to 'src') diff --git a/src/Language/Haskell/Stylish/Block.hs b/src/Language/Haskell/Stylish/Block.hs index bc47d18..fd680a8 100644 --- a/src/Language/Haskell/Stylish/Block.hs +++ b/src/Language/Haskell/Stylish/Block.hs @@ -10,6 +10,7 @@ module Language.Haskell.Stylish.Block , adjacent , merge , overlapping + , groupAdjacent ) where @@ -76,3 +77,15 @@ overlapping blocks = any (uncurry overlapping') $ zip blocks (drop 1 blocks) where overlapping' (Block _ e1) (Block s2 _) = e1 >= s2 + + +-------------------------------------------------------------------------------- +-- | Groups adjacent blocks into larger blocks +groupAdjacent :: [(Block a, b)] + -> [(Block a, [b])] +groupAdjacent = foldr go [] + where + -- This code is ugly and not optimal, and no fucks were given. + go (b1, x) gs = case break (adjacent b1 . fst) gs of + (_, []) -> (b1, [x]) : gs + (ys, ((b2, xs) : zs)) -> (merge b1 b2, x : xs) : (ys ++ zs) diff --git a/src/Language/Haskell/Stylish/Step/Imports.hs b/src/Language/Haskell/Stylish/Step/Imports.hs index 6ad95fc..e27a946 100644 --- a/src/Language/Haskell/Stylish/Step/Imports.hs +++ b/src/Language/Haskell/Stylish/Step/Imports.hs @@ -46,20 +46,6 @@ longestImport :: [H.ImportDecl l] -> Int longestImport = maximum . map (length . importName) --------------------------------------------------------------------------------- --- | Groups adjacent imports into larger import blocks -groupAdjacent :: [H.ImportDecl LineBlock] - -> [(LineBlock, [H.ImportDecl LineBlock])] -groupAdjacent = foldr go [] - where - -- This code is ugly and not optimal, and no fucks were given. - go imp is = case break (adjacent b1 . fst) is of - (_, []) -> (b1, [imp]) : is - (xs, ((b2, imps) : ys)) -> (merge b1 b2, imp : imps) : (xs ++ ys) - where - b1 = H.ann imp - - -------------------------------------------------------------------------------- -- | Compare imports for ordering compareImports :: H.ImportDecl l -> H.ImportDecl l -> Ordering @@ -179,7 +165,7 @@ step' columns align ls (module', _) = flip applyChanges ls where imps = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module' longest = longestImport imps - groups = groupAdjacent imps + groups = groupAdjacent [(H.ann i, i) | i <- imps] fileAlign = case align of File -> any H.importQualified imps -- cgit v1.2.3