packages feed

stylish-haskell 0.1.1.0 → 0.2.0.0

raw patch · 31 files changed

+1206/−475 lines, 31 filesdep +aesondep +bytestringdep +cmdargs

Dependencies added: aeson, bytestring, cmdargs, containers, directory, filepath, syb, yaml

Files

+ .stylish-haskell.yaml view
@@ -0,0 +1,55 @@+# stylish-haskell configuration file+# ==================================+#+# The stylish-haskell tool is mainly configured by specifying steps. These steps+# are a list, so they have an order, and one specific step may appear more than+# once (if needed). Each file is processed by these steps in the given order.+steps:+  # Convert some ASCII sequences to their Unicode equivalents. This is disabled+  # by default.+  # - unicode_syntax:+  #     # In order to make this work, we also need to insert the UnicodeSyntax+  #     # language pragma. If this flag is set to true, we insert it when it's+  #     # not already present. You may want to disable it if you configure+  #     # language extensions using some other method than pragmas. Default:+  #     # true.+  #     add_language_pragma: true++  # Import cleanup+  - imports:+      # There are different ways we can align names and lists.+      #+      # - global: Align the import names and import list throughout the entire+      #   file.+      #+      # - group: Only align the imports per group (a group is formed by adjacent+      #   import lines).+      #+      # - none: Do not perform any alignment.+      #+      # Default: global.+      align: global++  # Language pragmas+  - language_pragmas:+      # We can generate different styles of language pragma lists.+      #+      # - vertical: Vertical-spaced language pragmas, one per line.+      #+      # - compact: A more compact style.+      #+      # Default: vertical.+      style: vertical++      # stylish-haskell can detect redundancy of some language pragmas. If this+      # is set to true, it will remove those redundant pragmas. Default: true.+      remove_redundant: true++  # Replace tabs by spaces. This is disabled by default.+  # - tabs:+  #     # Number of spaces to use for each tab. Default: 8, as specified by the+  #     # Haskell report.+  #     spaces: 8++  # Remove trailing whitespace+  - trailing_whitespace: {}
src/Main.hs view
@@ -1,48 +1,65 @@ --------------------------------------------------------------------------------+{-# LANGUAGE DeriveDataTypeable #-} module Main     ( main     ) where   ---------------------------------------------------------------------------------import           Control.Applicative               ((<$>))-import           Data.Maybe                        (listToMaybe)-import           System.Environment                (getArgs)+import           Control.Monad          (forM_)+import           Data.List              (intercalate)+import           Data.Maybe             (listToMaybe)+import           Data.Version           (Version(..))+import           System.Console.CmdArgs   ---------------------------------------------------------------------------------import qualified StylishHaskell.Imports-import qualified StylishHaskell.LanguagePragmas-import           StylishHaskell.Parse-import           StylishHaskell.Stylish-import qualified StylishHaskell.TrailingWhitespace+import           Paths_stylish_haskell  (version)+import           StylishHaskell+import           StylishHaskell.Config+import           StylishHaskell.Step+import           StylishHaskell.Verbose   ---------------------------------------------------------------------------------runStylish :: Maybe FilePath -> Stylish -> Lines -> Lines-runStylish mfp f ls = case parseModule mfp (unlines ls) of-    Left err      -> error err  -- TODO: maybe return original lines?-    Right module' -> f ls module'+data StylishArgs = StylishArgs+    { config   :: Maybe FilePath+    , verbose  :: Bool+    , defaults :: Bool+    , files    :: [FilePath]+    } deriving (Data, Show, Typeable)   ---------------------------------------------------------------------------------chainStylish :: Maybe FilePath -> [Stylish] -> Lines -> Lines-chainStylish mfp filters = foldr (.) id filters'+stylishArgs :: StylishArgs+stylishArgs = StylishArgs+    { config   = Nothing &= typFile &= help "Configuration file"+    , verbose  = False              &= help "Run in verbose mode"+    , defaults = False              &= help "Dump default config and exit"+    , files    = []      &= typFile &= args+    } &= summary ("stylish-haskell-" ++ versionString version)   where-    filters' :: [Lines -> Lines]-    filters' = map (runStylish mfp) filters+    versionString = intercalate "." . map show . versionBranch   -------------------------------------------------------------------------------- main :: IO ()-main = do-    filePath <- listToMaybe <$> getArgs-    contents <- maybe getContents readFile filePath-    putStr $ unlines $ chainStylish filePath filters $ lines contents+main = cmdArgs stylishArgs >>= stylishHaskell+++--------------------------------------------------------------------------------+stylishHaskell :: StylishArgs -> IO ()+stylishHaskell sa+    | defaults sa = do+        fileName <- defaultConfigFilePath+        verbose' $ "Dumping config from " ++ fileName+        readFile fileName >>= putStr+    | otherwise   = do+        conf <- loadConfig verbose' (config sa)+        let steps = configSteps conf+        forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step"+        contents <- maybe getContents readFile filePath+        putStr $ unlines $ runSteps filePath steps $ lines contents   where-    filters =-        [ StylishHaskell.Imports.stylish-        , StylishHaskell.LanguagePragmas.stylish-        -- , StylishHaskell.Tabs.stylish-        , StylishHaskell.TrailingWhitespace.stylish-        ]+    verbose' = makeVerbose (verbose sa)+    filePath = listToMaybe $ files sa
+ src/StylishHaskell.hs view
@@ -0,0 +1,22 @@+--------------------------------------------------------------------------------+module StylishHaskell+    ( runStep+    , runSteps+    ) where+++--------------------------------------------------------------------------------+import           StylishHaskell.Parse+import           StylishHaskell.Step+++--------------------------------------------------------------------------------+runStep :: Maybe FilePath -> Step -> Lines -> Lines+runStep mfp step ls = case parseModule mfp (unlines ls) of+    Left err      -> error err  -- TODO: maybe return original lines?+    Right module' -> stepFilter step ls module'+++--------------------------------------------------------------------------------+runSteps :: Maybe FilePath -> [Step] -> Lines -> Lines+runSteps mfp = foldr (flip (.)) id . map (runStep mfp)
src/StylishHaskell/Block.hs view
@@ -1,8 +1,11 @@ -------------------------------------------------------------------------------- module StylishHaskell.Block     ( Block (..)+    , LineBlock+    , SpanBlock     , blockLength-    , fromSrcSpanInfo+    , linesFromSrcSpan+    , spanFromSrcSpan     , moveBlock     , adjacent     , merge@@ -17,43 +20,58 @@  -------------------------------------------------------------------------------- -- | Indicates a line span-data Block = Block+data Block a = Block     { blockStart :: Int     , blockEnd   :: Int     } deriving (Eq, Ord, Show)   ---------------------------------------------------------------------------------blockLength :: Block -> Int+type LineBlock = Block String+++--------------------------------------------------------------------------------+type SpanBlock = Block Char+++--------------------------------------------------------------------------------+blockLength :: Block a -> Int blockLength (Block start end) = end - start + 1   ---------------------------------------------------------------------------------fromSrcSpanInfo :: H.SrcSpanInfo -> Block-fromSrcSpanInfo = H.srcInfoSpan >>>+linesFromSrcSpan :: H.SrcSpanInfo -> LineBlock+linesFromSrcSpan = H.srcInfoSpan >>>     H.srcSpanStartLine &&& H.srcSpanEndLine >>>     arr (uncurry Block)   ---------------------------------------------------------------------------------moveBlock :: Int -> Block -> Block+spanFromSrcSpan :: H.SrcSpanInfo -> SpanBlock+spanFromSrcSpan = H.srcInfoSpan >>>+    H.srcSpanStartColumn &&& H.srcSpanEndColumn >>>+    arr (uncurry Block)+++--------------------------------------------------------------------------------+moveBlock :: Int -> Block a -> Block a moveBlock offset (Block start end) = Block (start + offset) (end + offset)   ---------------------------------------------------------------------------------adjacent :: Block -> Block -> Bool+adjacent :: Block a -> Block a -> Bool adjacent b1 b2 = follows b1 b2 || follows b2 b1   where     follows (Block _ e1) (Block s2 _) = e1 + 1 == s2   ---------------------------------------------------------------------------------merge :: Block -> Block -> Block+merge :: Block a -> Block a -> Block a merge (Block s1 e1) (Block s2 e2) = Block (min s1 s2) (max e1 e2)   ---------------------------------------------------------------------------------overlapping :: [Block] -> Bool+overlapping :: [Block a] -> Bool overlapping blocks =     any (uncurry overlapping') $ zip blocks (drop 1 blocks)   where
+ src/StylishHaskell/Config.hs view
@@ -0,0 +1,175 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module StylishHaskell.Config+    ( Config (..)+    , defaultConfigFilePath+    , configFilePath+    , loadConfig+    ) where+++--------------------------------------------------------------------------------+import           Control.Applicative                    ((<$>), (<*>))+import           Control.Monad                          (forM, msum, mzero)+import           Data.Aeson                             (FromJSON(..))+import qualified Data.Aeson                             as A+import qualified Data.Aeson.Types                       as A+import qualified Data.ByteString                        as B+import           Data.List                              (intercalate)+import           Data.Map                               (Map)+import qualified Data.Map                               as M+import           Data.Yaml                              (decodeEither)+import           System.Directory+import           System.FilePath                        ((</>))+++--------------------------------------------------------------------------------+import           Paths_stylish_haskell                  (getDataFileName)+import           StylishHaskell.Step+import qualified StylishHaskell.Step.Imports            as Imports+import qualified StylishHaskell.Step.LanguagePragmas    as LanguagePragmas+import qualified StylishHaskell.Step.Tabs               as Tabs+import qualified StylishHaskell.Step.TrailingWhitespace as TrailingWhitespace+import qualified StylishHaskell.Step.UnicodeSyntax      as UnicodeSyntax+import           StylishHaskell.Verbose+++--------------------------------------------------------------------------------+data Config = Config+    { configSteps :: [Step]+    }+++--------------------------------------------------------------------------------+instance FromJSON Config where+    parseJSON = parseConfig+++--------------------------------------------------------------------------------+emptyConfig :: Config+emptyConfig = Config []+++--------------------------------------------------------------------------------+configFileName :: String+configFileName = ".stylish-haskell.yaml"+++--------------------------------------------------------------------------------+defaultConfigFilePath :: IO FilePath+defaultConfigFilePath = getDataFileName ".stylish-haskell.yaml"+++--------------------------------------------------------------------------------+configFilePath :: Verbose -> Maybe FilePath -> IO (Maybe FilePath)+configFilePath verbose userSpecified = do+    (current, currentE) <- check $ (</> configFileName) <$> getCurrentDirectory+    (home, homeE)       <- check $ (</> configFileName) <$> getHomeDirectory+    (def, defE)         <- check defaultConfigFilePath+    return $ msum+        [ userSpecified+        , if currentE then Just current else Nothing+        , if homeE then Just home else Nothing+        , if defE then Just def else Nothing+        ]+  where+    check fp = do+        fp' <- fp+        ex  <- doesFileExist fp'+        verbose $ fp' ++ if ex then " exists" else " does not exist"+        return (fp', ex)+++--------------------------------------------------------------------------------+loadConfig :: Verbose -> Maybe FilePath -> IO Config+loadConfig verbose mfp = do+    mfp' <- configFilePath verbose mfp+    case mfp' of+        Nothing -> do+            verbose $ "Using empty configuration"+            return emptyConfig+        Just fp -> do+            verbose $ "Loading configuration at " ++ fp+            bs <- B.readFile fp+            case decodeEither bs of+                Left err     -> error $+                    "StylishHaskell.Config.loadConfig: " ++ err+                Right config -> return config+++--------------------------------------------------------------------------------+parseConfig :: A.Value -> A.Parser Config+parseConfig (A.Object o) = Config+    <$> (o A..: "steps" >>= fmap concat . mapM parseSteps)+parseConfig _            = mzero+++--------------------------------------------------------------------------------+catalog :: Map String (A.Object -> A.Parser Step)+catalog = M.fromList+    [ ("imports",             parseImports)+    , ("language_pragmas",    parseLanguagePragmas)+    , ("tabs",                parseTabs)+    , ("trailing_whitespace", parseTrailingWhitespace)+    , ("unicode_syntax",      parseUnicodeSyntax)+    ]+++--------------------------------------------------------------------------------+parseSteps :: A.Value -> A.Parser [Step]+parseSteps val = do+    map' <- parseJSON val :: A.Parser (Map String A.Value)+    forM (M.toList map') $ \(k, v) -> case (M.lookup k catalog, v) of+        (Just parser, A.Object o) -> parser o+        _                         -> fail $ "Invalid declaration for " ++ k+++--------------------------------------------------------------------------------+-- | Utility for enum-like options+parseEnum :: [(String, a)] -> a -> Maybe String -> A.Parser a+parseEnum _    def Nothing  = return def+parseEnum strs _   (Just k) = case lookup k strs of+    Just v  -> return v+    Nothing -> fail $ "Unknown option: " ++ k ++ ", should be one of: " +++        intercalate ", " (map fst strs)+++--------------------------------------------------------------------------------+parseImports :: A.Object -> A.Parser Step+parseImports o = Imports.step+    <$> (o A..:? "align" >>= parseEnum aligns Imports.Global)+  where+    aligns =+        [ ("global", Imports.Global)+        , ("group",  Imports.Group)+        , ("none",   Imports.None)+        ]+++--------------------------------------------------------------------------------+parseLanguagePragmas :: A.Object -> A.Parser Step+parseLanguagePragmas o = LanguagePragmas.step+    <$> (o A..:? "style" >>= parseEnum styles LanguagePragmas.Vertical)+    <*> o A..:? "remove_redundant" A..!= True+  where+    styles =+        [ ("vertical", LanguagePragmas.Vertical)+        , ("compact",  LanguagePragmas.Compact)+        ]+++--------------------------------------------------------------------------------+parseTabs :: A.Object -> A.Parser Step+parseTabs o = Tabs.step+    <$> o A..:? "spaces" A..!= 8+++--------------------------------------------------------------------------------+parseTrailingWhitespace :: A.Object -> A.Parser Step+parseTrailingWhitespace _ = return TrailingWhitespace.step+++--------------------------------------------------------------------------------+parseUnicodeSyntax :: A.Object -> A.Parser Step+parseUnicodeSyntax o = UnicodeSyntax.step+    <$> o A..:? "add_language_pragma" A..!= True
src/StylishHaskell/Editor.hs view
@@ -20,30 +20,29 @@  -------------------------------------------------------------------------------- import           StylishHaskell.Block-import           StylishHaskell.Stylish   -------------------------------------------------------------------------------- -- | Changes the lines indicated by the 'Block' into the given 'Lines'-data Change = Change-    { changeBlock :: Block-    , changeLines :: Lines+data Change a = Change+    { changeBlock :: Block a+    , changeLines :: [a]     } deriving (Eq, Show)   ---------------------------------------------------------------------------------moveChange :: Int -> Change -> Change+moveChange :: Int -> Change a -> Change a moveChange offset (Change block ls) = Change (moveBlock offset block) ls   -------------------------------------------------------------------------------- -- | Number of additional lines introduced when a change is made.-changeExtraLines :: Change -> Int+changeExtraLines :: Change a -> Int changeExtraLines (Change block ls) = length ls - blockLength block   ---------------------------------------------------------------------------------applyChanges :: [Change] -> Lines -> Lines+applyChanges :: [Change a] -> [a] -> [a] applyChanges changes     | overlapping blocks = error $         "StylishHaskell.Editor.applyChanges: " ++@@ -77,29 +76,29 @@  -------------------------------------------------------------------------------- -- | Change a block of lines for some other lines-change :: Block -> Lines -> Change+change :: Block a -> [a] -> Change a change = Change   -------------------------------------------------------------------------------- -- | Change a single line for some other lines-changeLine :: Int -> Lines -> Change+changeLine :: Int -> [a] -> Change a changeLine start = change (Block start start)   -------------------------------------------------------------------------------- -- | Delete a block of lines-delete :: Block -> Change+delete :: Block a -> Change a delete block = Change block []   -------------------------------------------------------------------------------- -- | Delete a single line-deleteLine :: Int -> Change+deleteLine :: Int -> Change a deleteLine start = delete (Block start start)   -------------------------------------------------------------------------------- -- | Insert something /before/ the given lines-insert :: Int -> Lines -> Change+insert :: Int -> [a] -> Change a insert start = Change (Block start (start - 1))
− src/StylishHaskell/Imports.hs 
@@ -1,110 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Imports-    ( stylish-    ) where------------------------------------------------------------------------------------import           Control.Arrow                   ((&&&))-import           Data.Char                       (isAlpha)-import           Data.List                       (sortBy)-import           Data.Maybe                      (isJust, maybeToList)-import           Data.Ord                        (comparing)-import qualified Language.Haskell.Exts.Annotated as H------------------------------------------------------------------------------------import           StylishHaskell.Block-import           StylishHaskell.Editor-import           StylishHaskell.Stylish-import           StylishHaskell.Util------------------------------------------------------------------------------------imports :: H.Module l -> [H.ImportDecl l]-imports (H.Module _ _ _ is _) = is-imports _                     = []------------------------------------------------------------------------------------importName :: H.ImportDecl l -> String-importName i = let (H.ModuleName _ n) = H.importModule i in n------------------------------------------------------------------------------------longestImport :: [H.ImportDecl l] -> Int-longestImport = maximum . map (length . importName)-------------------------------------------------------------------------------------- | Groups adjacent imports into larger import blocks-groupAdjacent :: [H.ImportDecl Block] -> [(Block, [H.ImportDecl Block])]-groupAdjacent = foldr step []-  where-    -- This code is ugly and not optimal, and no fucks were given.-    step 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-compareImports = comparing (importName &&& H.importQualified)-------------------------------------------------------------------------------------- | The implementation is a bit hacky to get proper sorting for input specs:--- constructors first, followed by functions, and then operators.-compareImportSpecs :: H.ImportSpec l -> H.ImportSpec l -> Ordering-compareImportSpecs = comparing key-  where-    key :: H.ImportSpec l -> (Int, Int, String)-    key (H.IVar _ x)         = let n = nameToString x in (1, operator n, n)-    key (H.IAbs _ x)         = (0, 0, nameToString x)-    key (H.IThingAll _ x)    = (0, 0, nameToString x)-    key (H.IThingWith _ x _) = (0, 0, nameToString x)--    operator []      = 0  -- But this should not happen-    operator (x : _) = if isAlpha x then 0 else 1-------------------------------------------------------------------------------------- | Sort the input spec list inside an 'H.ImportDecl'-sortImportSpecs :: H.ImportDecl l -> H.ImportDecl l-sortImportSpecs imp = imp {H.importSpecs = fmap sort $ H.importSpecs imp}-  where-    sort (H.ImportSpecList l h specs) = H.ImportSpecList l h $-        sortBy compareImportSpecs specs------------------------------------------------------------------------------------prettyImport :: Int -> H.ImportDecl l -> String-prettyImport longest imp = unwords $ concat-    [ ["import"]-    , [if H.importQualified imp then "qualified" else "         "]-    , [(if hasExtras then padRight longest else id) (importName imp)]-    , ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp]-    , [H.prettyPrint specs | specs <- maybeToList $ H.importSpecs imp]-    ]-  where-    hasExtras = isJust (H.importAs imp) || isJust (H.importSpecs imp)------------------------------------------------------------------------------------prettyImportGroup :: Int -> [H.ImportDecl Block] -> Lines-prettyImportGroup longest = map (prettyImport longest) . sortBy compareImports------------------------------------------------------------------------------------stylish :: Stylish-stylish ls (module', _) = flip applyChanges ls-    [ change block (prettyImportGroup longest importGroup)-    | (block, importGroup) <- groups-    ]-  where-    imps    = map sortImportSpecs $ imports $ fmap fromSrcSpanInfo module'-    longest = longestImport imps-    groups  = groupAdjacent imps
− src/StylishHaskell/LanguagePragmas.hs 
@@ -1,53 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.LanguagePragmas-    ( stylish-    ) where------------------------------------------------------------------------------------import           Data.List                       (nub, sort)-import qualified Language.Haskell.Exts.Annotated as H------------------------------------------------------------------------------------import           StylishHaskell.Block-import           StylishHaskell.Editor-import           StylishHaskell.Stylish-import           StylishHaskell.Util------------------------------------------------------------------------------------pragmas :: H.Module l -> [(l, [String])]-pragmas (H.Module _ _ ps _ _) =-    [(l, map nameToString names) | H.LanguagePragma l names <- ps]-pragmas _                     = []-------------------------------------------------------------------------------------- | The start of the first block-firstLocation :: [(Block, [String])] -> Int-firstLocation = minimum . map (blockStart . fst)-------------------------------------------------------------------------------------- | TODO: multiple lines if longer than 80 columns-prettyPragmas :: [String] -> Lines-prettyPragmas pragmas' =-    [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}"-    | pragma <- pragmas'-    ]-  where-    longest = maximum $ map length pragmas'------------------------------------------------------------------------------------stylish :: Stylish-stylish ls (module', _)-    | null pragmas' = ls-    | otherwise     = applyChanges changes ls-  where-    pragmas' = pragmas $ fmap fromSrcSpanInfo module'-    deletes  = map (delete . fst) pragmas'-    uniques  = nub $ sort $ concatMap snd pragmas'-    loc      = firstLocation pragmas'-    changes  = insert loc (prettyPragmas uniques) : deletes
src/StylishHaskell/Parse.hs view
@@ -10,7 +10,7 @@   ---------------------------------------------------------------------------------import           StylishHaskell.Stylish+import           StylishHaskell.Step   --------------------------------------------------------------------------------
+ src/StylishHaskell/Step.hs view
@@ -0,0 +1,32 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step+    ( Lines+    , Module+    , Step (..)+    , makeStep+    ) where+++--------------------------------------------------------------------------------+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+type Lines = [String]+++--------------------------------------------------------------------------------+-- | Concrete module type+type Module = (H.Module H.SrcSpanInfo, [H.Comment])+++--------------------------------------------------------------------------------+data Step = Step+    { stepName   :: String+    , stepFilter :: Lines -> Module -> Lines+    }+++--------------------------------------------------------------------------------+makeStep :: String -> (Lines -> Module -> Lines) -> Step+makeStep = Step
+ src/StylishHaskell/Step/Imports.hs view
@@ -0,0 +1,142 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.Imports+    ( Align (..)+    , step+    ) where+++--------------------------------------------------------------------------------+import           Control.Arrow                   ((&&&))+import           Data.Char                       (isAlpha)+import           Data.List                       (sortBy)+import           Data.Maybe                      (isJust, maybeToList)+import           Data.Ord                        (comparing)+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+import           StylishHaskell.Block+import           StylishHaskell.Editor+import           StylishHaskell.Step+import           StylishHaskell.Util+++--------------------------------------------------------------------------------+data Align+    = Global+    | Group+    | None+    deriving (Eq, Show)+++--------------------------------------------------------------------------------+imports :: H.Module l -> [H.ImportDecl l]+imports (H.Module _ _ _ is _) = is+imports _                     = []+++--------------------------------------------------------------------------------+importName :: H.ImportDecl l -> String+importName i = let (H.ModuleName _ n) = H.importModule i in n+++--------------------------------------------------------------------------------+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+compareImports = comparing (importName &&& H.importQualified)+++--------------------------------------------------------------------------------+-- | The implementation is a bit hacky to get proper sorting for input specs:+-- constructors first, followed by functions, and then operators.+compareImportSpecs :: H.ImportSpec l -> H.ImportSpec l -> Ordering+compareImportSpecs = comparing key+  where+    key :: H.ImportSpec l -> (Int, Int, String)+    key (H.IVar _ x)         = let n = nameToString x in (1, operator n, n)+    key (H.IAbs _ x)         = (0, 0, nameToString x)+    key (H.IThingAll _ x)    = (0, 0, nameToString x)+    key (H.IThingWith _ x _) = (0, 0, nameToString x)++    operator []      = 0  -- But this should not happen+    operator (x : _) = if isAlpha x then 0 else 1+++--------------------------------------------------------------------------------+-- | Sort the input spec list inside an 'H.ImportDecl'+sortImportSpecs :: H.ImportDecl l -> H.ImportDecl l+sortImportSpecs imp = imp {H.importSpecs = fmap sort $ H.importSpecs imp}+  where+    sort (H.ImportSpecList l h specs) = H.ImportSpecList l h $+        sortBy compareImportSpecs specs+++--------------------------------------------------------------------------------+prettyImport :: Bool -> Bool -> Int -> H.ImportDecl l -> String+prettyImport padQualified padName longest imp = unwords $ concat+    [ ["import"]+    , qualified+    , [(if hasExtras && padName then padRight longest else id) (importName imp)]+    , ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp]+    , [H.prettyPrint specs | specs <- maybeToList $ H.importSpecs imp]+    ]+  where+    hasExtras = isJust (H.importAs imp) || isJust (H.importSpecs imp)++    qualified+        | H.importQualified imp = ["qualified"]+        | padQualified          = ["         "]+        | otherwise             = []+++--------------------------------------------------------------------------------+prettyImportGroup :: Align -> Int -> [H.ImportDecl LineBlock] -> Lines+prettyImportGroup align longest imps =+    map (prettyImport padQual padName longest') $ sortBy compareImports imps+  where+    longest' = case align of+        Group -> longestImport imps+        _     -> longest++    padName = align /= None++    padQual = case align of+        Global -> True+        Group  -> any H.importQualified imps+        None   -> False+++--------------------------------------------------------------------------------+step :: Align -> Step+step = makeStep "Imports" . step'+++--------------------------------------------------------------------------------+step' :: Align -> Lines -> Module -> Lines+step' align ls (module', _) = flip applyChanges ls+    [ change block (prettyImportGroup align longest importGroup)+    | (block, importGroup) <- groups+    ]+  where+    imps    = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module'+    longest = longestImport imps+    groups  = groupAdjacent imps
+ src/StylishHaskell/Step/LanguagePragmas.hs view
@@ -0,0 +1,120 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.LanguagePragmas+    ( Style (..)+    , step++      -- * Utilities+    , addLanguagePragma+    ) where+++--------------------------------------------------------------------------------+import           Data.List                       (nub, sort)+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+import           StylishHaskell.Block+import           StylishHaskell.Editor+import           StylishHaskell.Step+import           StylishHaskell.Util+++--------------------------------------------------------------------------------+data Style+    = Vertical+    | Compact+    deriving (Eq, Show)+++--------------------------------------------------------------------------------+pragmas :: H.Module l -> [(l, [String])]+pragmas (H.Module _ _ ps _ _) =+    [(l, map nameToString names) | H.LanguagePragma l names <- ps]+pragmas _                     = []+++--------------------------------------------------------------------------------+-- | The start of the first block+firstLocation :: [(Block a, [String])] -> Int+firstLocation = minimum . map (blockStart . fst)+++--------------------------------------------------------------------------------+-- | TODO: multiple lines if longer than 80 columns+verticalPragmas :: [String] -> Lines+verticalPragmas pragmas' =+    [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}"+    | pragma <- pragmas'+    ]+  where+    longest = maximum $ map length pragmas'+++--------------------------------------------------------------------------------+compactPragmas :: [String] -> Lines+compactPragmas pragmas' = wrap 80 "{-# LANGUAGE" 13 $+    map (++ ",") (init pragmas') ++ [last pragmas', "#-}"]+++--------------------------------------------------------------------------------+prettyPragmas :: Style -> [String] -> Lines+prettyPragmas Vertical = verticalPragmas+prettyPragmas Compact  = compactPragmas+++--------------------------------------------------------------------------------+step :: Style -> Bool -> Step+step style = makeStep "LanguagePragmas" . step' style+++--------------------------------------------------------------------------------+step' :: Style -> Bool -> Lines -> Module -> Lines+step' style removeRedundant ls (module', _)+    | null pragmas' = ls+    | otherwise     = applyChanges changes ls+  where+    filterRedundant+        | removeRedundant = filter (not . isRedundant module')+        | otherwise       = id++    pragmas' = pragmas $ fmap linesFromSrcSpan module'+    uniques  = filterRedundant $ nub $ sort $ snd =<< pragmas'+    loc      = firstLocation pragmas'+    deletes  = map (delete . fst) pragmas'+    changes  = insert loc (prettyPragmas style uniques) : deletes+++--------------------------------------------------------------------------------+-- | Add a LANGUAGE pragma to a module if it is not present already.+addLanguagePragma :: String -> H.Module H.SrcSpanInfo -> [Change String]+addLanguagePragma prag modu+    | prag `elem` present = []+    | otherwise           = [insert line ["{-# LANGUAGE " ++ prag ++ " #-}"]]+  where+    pragmas' = pragmas (fmap linesFromSrcSpan modu)+    present  = concatMap snd pragmas'+    line     = if null pragmas' then 1 else firstLocation pragmas'+++--------------------------------------------------------------------------------+-- | Check if a language pragma is redundant. We can't do this for all pragmas,+-- but we do a best effort.+isRedundant :: H.Module H.SrcSpanInfo -> String -> Bool+isRedundant m "ViewPatterns" = isRedundantViewPatterns m+isRedundant m "BangPatterns" = isRedundantBangPatterns m+isRedundant _ _              = False+++--------------------------------------------------------------------------------+-- | Check if the ViewPatterns language pragma is redundant.+isRedundantViewPatterns :: H.Module H.SrcSpanInfo -> Bool+isRedundantViewPatterns m = null+    [() | H.PViewPat _ _ _ <- everything m :: [H.Pat H.SrcSpanInfo]]+++--------------------------------------------------------------------------------+-- | Check if the BangPatterns language pragma is redundant.+isRedundantBangPatterns :: H.Module H.SrcSpanInfo -> Bool+isRedundantBangPatterns m = null+    [() | H.PBangPat _ _ <- everything m :: [H.Pat H.SrcSpanInfo]]
+ src/StylishHaskell/Step/Tabs.hs view
@@ -0,0 +1,21 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.Tabs+    ( step+    ) where+++--------------------------------------------------------------------------------+import           StylishHaskell.Step+++--------------------------------------------------------------------------------+removeTabs :: Int -> String -> String+removeTabs spaces = concatMap removeTabs'+  where+    removeTabs' '\t' = replicate spaces ' '+    removeTabs' x    = [x]+++--------------------------------------------------------------------------------+step :: Int -> Step+step spaces = makeStep "Tabs" $ \ls _ -> map (removeTabs spaces) ls
+ src/StylishHaskell/Step/TrailingWhitespace.hs view
@@ -0,0 +1,22 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.TrailingWhitespace+    ( step+    ) where+++--------------------------------------------------------------------------------+import           Data.Char            (isSpace)+++--------------------------------------------------------------------------------+import           StylishHaskell.Step+++--------------------------------------------------------------------------------+dropTrailingWhitespace :: String -> String+dropTrailingWhitespace = reverse . dropWhile isSpace . reverse+++--------------------------------------------------------------------------------+step :: Step+step = makeStep "TrailingWhitespace" $ \ls _ -> map dropTrailingWhitespace ls
+ src/StylishHaskell/Step/UnicodeSyntax.hs view
@@ -0,0 +1,135 @@+--------------------------------------------------------------------------------+{-# LANGUAGE ViewPatterns #-}+module StylishHaskell.Step.UnicodeSyntax+    ( step+    ) where+++--------------------------------------------------------------------------------+import           Data.List                              (isPrefixOf, sort)+import           Data.Map                               (Map)+import qualified Data.Map                               as M+import           Data.Maybe                             (maybeToList)+import qualified Language.Haskell.Exts.Annotated        as H+++--------------------------------------------------------------------------------+import           StylishHaskell.Block+import           StylishHaskell.Editor+import           StylishHaskell.Step+import           StylishHaskell.Step.LanguagePragmas (addLanguagePragma)+import           StylishHaskell.Util+++--------------------------------------------------------------------------------+unicodeReplacements :: Map String String+unicodeReplacements = M.fromList+    [ ("::", "∷")+    , ("=>", "⇒")+    , ("->", "→")+    ]+++--------------------------------------------------------------------------------+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+  where+    go _ []      _         = []+    go _ _       []        = []+    go r (x : xs) (l : ls)+        | r == x                    = l : go (r + 1) xs ls+        | otherwise                 = go (r + 1) (x : xs) ls+++--------------------------------------------------------------------------------+groupPerLine :: [((Int, Int), a)] -> [(Int, [(Int, a)])]+groupPerLine = M.toList . M.fromListWith (++) .+    map (\((r, c), x) -> (r, [(c, x)]))+++--------------------------------------------------------------------------------+typeSigs :: H.Module H.SrcSpanInfo -> Lines -> [((Int, Int), String)]+typeSigs module' ls =+    [ (pos, "::")+    | H.TypeSig loc _ _  <- everything module' :: [H.Decl H.SrcSpanInfo]+    , (start, end)       <- infoPoints loc+    , pos                <- maybeToList $ between start end "::" ls+    ]+++--------------------------------------------------------------------------------+contexts :: H.Module H.SrcSpanInfo -> Lines -> [((Int, Int), String)]+contexts module' ls =+    [ (pos, "=>")+    | context      <- everything module' :: [H.Context H.SrcSpanInfo]+    , (start, end) <- infoPoints $ H.ann context+    , pos          <- maybeToList $ between start end "=>" ls+    ]+++--------------------------------------------------------------------------------+typeFuns :: H.Module H.SrcSpanInfo -> Lines -> [((Int, Int), String)]+typeFuns module' ls =+    [ (pos, "->")+    | H.TyFun _ t1 t2 <- everything module'+    , let start = H.srcSpanEnd $ H.srcInfoSpan $ H.ann t1+    , let end   = H.srcSpanStart $ H.srcInfoSpan $ H.ann t2+    , pos <- maybeToList $ between start end "->" ls+    ]+++--------------------------------------------------------------------------------+-- | Search for a needle in a haystack of lines. Only part the inside (startRow,+-- startCol), (endRow, endCol) is searched. The return value is the position of+-- the needle.+between :: (Int, Int) -> (Int, Int) -> String -> Lines -> Maybe (Int, Int)+between (startRow, startCol) (endRow, endCol) needle =+    search (startRow, startCol) .+    withLast (take endCol) .+    withHead (drop $ startCol - 1) .+    take (endRow - startRow + 1) .+    drop (startRow - 1)+  where+    withHead _ []       = []+    withHead f (x : xs) = (f x) : xs++    withLast f [x]      = [f x]+    withLast f (x : xs) = x : withLast f xs+    withLast _ []       = []++    search _      []            = Nothing+    search (r, _) ([] : xs)     = search (r + 1, 1) xs+    search (r, c) (x : xs)+        | needle `isPrefixOf` x = Just (r, c)+        | otherwise             = search (r, c + 1) (tail x : xs)+++--------------------------------------------------------------------------------+step :: Bool -> Step+step = makeStep "UnicodeSyntax" . step'+++--------------------------------------------------------------------------------+step' :: Bool -> Lines -> Module -> Lines+step' alp ls (module', _) = applyChanges changes ls+  where+    changes = (if alp then addLanguagePragma "UnicodeSyntax" module' else []) +++        replaceAll perLine ls+    perLine = sort $ groupPerLine $+        typeSigs module' ls +++        contexts module' ls +++        typeFuns module' ls
− src/StylishHaskell/Stylish.hs 
@@ -1,23 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Stylish-    ( Lines-    , Module-    , Stylish-    ) where------------------------------------------------------------------------------------import qualified Language.Haskell.Exts.Annotated as H------------------------------------------------------------------------------------type Lines = [String]-------------------------------------------------------------------------------------- | Concrete module type-type Module = (H.Module H.SrcSpanInfo, [H.Comment])------------------------------------------------------------------------------------type Stylish = Lines -> Module -> Lines
− src/StylishHaskell/Tabs.hs 
@@ -1,21 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Tabs-    ( stylish-    ) where------------------------------------------------------------------------------------import           StylishHaskell.Stylish------------------------------------------------------------------------------------removeTabs :: String -> String-removeTabs = concatMap removeTabs'-  where-    removeTabs' '\t' = "    "-    removeTabs' x    = [x]------------------------------------------------------------------------------------stylish :: Stylish-stylish ls _ = map removeTabs ls
− src/StylishHaskell/TrailingWhitespace.hs 
@@ -1,22 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.TrailingWhitespace-    ( stylish-    ) where------------------------------------------------------------------------------------import           Data.Char            (isSpace)------------------------------------------------------------------------------------import           StylishHaskell.Stylish------------------------------------------------------------------------------------dropTrailingWhitespace :: String -> String-dropTrailingWhitespace = reverse . dropWhile isSpace . reverse------------------------------------------------------------------------------------stylish :: Stylish-stylish ls _ = map dropTrailingWhitespace ls
src/StylishHaskell/Util.hs view
@@ -2,15 +2,26 @@ module StylishHaskell.Util     ( nameToString     , padRight+    , everything+    , infoPoints+    , wrap     ) where   --------------------------------------------------------------------------------+import           Control.Arrow                   ((&&&), (>>>))+import           Data.Data                       (Data)+import qualified Data.Generics                   as G+import           Data.Maybe                      (maybeToList)+import           Data.Typeable                   (cast) import qualified Language.Haskell.Exts.Annotated as H   ----------------------------------------------------------------------------------- | TODO: put this in utilities?+import           StylishHaskell.Step+++-------------------------------------------------------------------------------- nameToString :: H.Name l -> String nameToString (H.Ident _ str)  = str nameToString (H.Symbol _ str) = str@@ -19,3 +30,35 @@ -------------------------------------------------------------------------------- padRight :: Int -> String -> String padRight len str = str ++ replicate (len - length str) ' '+++--------------------------------------------------------------------------------+everything :: (Data a, Data b) => a -> [b]+everything = G.everything (++) (maybeToList . cast)+++--------------------------------------------------------------------------------+infoPoints :: H.SrcSpanInfo -> [((Int, Int), (Int, Int))]+infoPoints = H.srcInfoPoints >>> map (H.srcSpanStart &&& H.srcSpanEnd)+++--------------------------------------------------------------------------------+wrap :: Int       -- ^ Maximum line width+     -> String    -- ^ Leading string+     -> Int       -- ^ Indentation+     -> [String]  -- ^ Strings to add/wrap+     -> Lines     -- ^ Resulting lines+wrap maxWidth leading indent strs =+    let (ls, curr, _) = foldl step ([], leading, length leading) strs+    in ls ++ [curr]+  where+    -- TODO: In order to optimize this, use a difference list instead of a+    -- regular list for 'ls'.+    step (ls, curr, width) str+        | width' > maxWidth = (ls ++ [curr], spaces ++ str, indent + len)+        | otherwise         = (ls, curr ++ " " ++ str, width')+      where+        len    = length str+        width' = width + 1 + len++    spaces = replicate indent ' '
stylish-haskell.cabal view
@@ -1,5 +1,5 @@ Name:          stylish-haskell-Version:       0.1.1.0+Version:       0.2.0.0 Synopsis:      Haskell code prettifier Homepage:      https://github.com/jaspervdj/stylish-haskell License:       BSD3@@ -18,25 +18,40 @@      <https://github.com/jaspervdj/stylish-haskell/blob/master/README.markdown> +Data-files:+  .stylish-haskell.yaml+ Executable stylish-haskell   Ghc-options:    -Wall   Hs-source-dirs: src   Main-is:        Main.hs    Other-modules:+    Paths_stylish_haskell+    StylishHaskell     StylishHaskell.Block+    StylishHaskell.Config     StylishHaskell.Editor-    StylishHaskell.Imports-    StylishHaskell.LanguagePragmas     StylishHaskell.Parse-    StylishHaskell.Stylish-    StylishHaskell.Tabs-    StylishHaskell.TrailingWhitespace+    StylishHaskell.Step+    StylishHaskell.Step.Imports+    StylishHaskell.Step.LanguagePragmas+    StylishHaskell.Step.Tabs+    StylishHaskell.Step.TrailingWhitespace+    StylishHaskell.Step.UnicodeSyntax     StylishHaskell.Util    Build-depends:+    aeson            >= 0.6  && < 0.7,     base             >= 4    && < 5,-    haskell-src-exts >= 1.13 && < 1.14+    bytestring       >= 0.9  && < 0.10,+    cmdargs          >= 0.9  && < 0.10,+    containers       >= 0.3  && < 0.6,+    directory        >= 1.1  && < 1.2,+    filepath         >= 1.1  && < 1.4,+    haskell-src-exts >= 1.13 && < 1.14,+    syb              >= 0.3  && < 0.4,+    yaml             >= 0.7  && < 0.8  Test-suite stylish-haskell-tests   Ghc-options:    -Wall@@ -45,19 +60,28 @@   Type:           exitcode-stdio-1.0    Other-modules:-    StylishHaskell.Imports.Tests-    StylishHaskell.LanguagePragmas.Tests+    StylishHaskell.Step.Imports.Tests+    StylishHaskell.Step.LanguagePragmas.Tests+    StylishHaskell.Step.Tabs.Tests+    StylishHaskell.Step.TrailingWhitespace.Tests+    StylishHaskell.Step.UnicodeSyntax.Tests     StylishHaskell.Tests.Util-    StylishHaskell.Tabs.Tests-    StylishHaskell.TrailingWhitespace.Tests    Build-depends:     HUnit                >= 1.2 && < 1.3,     test-framework       >= 0.4 && < 0.7,     test-framework-hunit >= 0.2 && < 0.3,     -- Copied from regular dependencies...+    aeson            >= 0.6  && < 0.7,     base             >= 4    && < 5,-    haskell-src-exts >= 1.13 && < 1.14+    bytestring       >= 0.9  && < 0.10,+    cmdargs          >= 0.9  && < 0.10,+    containers       >= 0.3  && < 0.6,+    directory        >= 1.1  && < 1.2,+    filepath         >= 1.1  && < 1.4,+    haskell-src-exts >= 1.13 && < 1.14,+    syb              >= 0.3  && < 0.4,+    yaml             >= 0.7  && < 0.8  Source-repository head   Type:     git
− tests/StylishHaskell/Imports/Tests.hs 
@@ -1,51 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Imports.Tests-    ( tests-    ) where------------------------------------------------------------------------------------import           Test.Framework                 (Test, testGroup)-import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     ((@=?))------------------------------------------------------------------------------------import           StylishHaskell.Imports-import           StylishHaskell.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "StylishHaskell.Imports.Tests"-    [ case01-    ]------------------------------------------------------------------------------------case01 :: Test-case01 = testCase "case 01" $ expected @=? testStylish stylish input-  where-    input = unlines-        [ "module Herp where"-        , ""-        , "import qualified Data.Map  as M"-        , "import Control.Monad"-        , "import       Data.Map     (lookup, (!), insert, Map)"-        , ""-        , "import Herp.Derp.Internals"-        , ""-        , "herp = putStrLn \"import Hello world\""-        ]--    expected = unlines-        [ "module Herp where"-        , ""-        , "import           Control.Monad"-        , "import           Data.Map            (Map, insert, lookup, (!))"-        , "import qualified Data.Map            as M"-        , ""-        , "import           Herp.Derp.Internals"-        , ""-        , "herp = putStrLn \"import Hello world\""-        ]
− tests/StylishHaskell/LanguagePragmas/Tests.hs 
@@ -1,41 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.LanguagePragmas.Tests-    ( tests-    ) where------------------------------------------------------------------------------------import           Test.Framework                 (Test, testGroup)-import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     ((@=?))------------------------------------------------------------------------------------import           StylishHaskell.LanguagePragmas-import           StylishHaskell.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "StylishHaskell.LanguagePragmas.Tests"-    [ case01-    ]------------------------------------------------------------------------------------case01 :: Test-case01 = testCase "case 01" $ expected @=? testStylish stylish input-  where-    input = unlines-        [ "{-# LANGUAGE ViewPatterns #-}"-        , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"-        , "{-# LANGUAGE ScopedTypeVariables #-}"-        , "module Main where"-        ]--    expected = unlines-        [ "{-# LANGUAGE ScopedTypeVariables #-}"-        , "{-# LANGUAGE TemplateHaskell     #-}"-        , "{-# LANGUAGE ViewPatterns        #-}"-        , "module Main where"-        ]
+ tests/StylishHaskell/Step/Imports/Tests.hs view
@@ -0,0 +1,90 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.Imports.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     ((@=?))+++--------------------------------------------------------------------------------+import           StylishHaskell.Step.Imports+import           StylishHaskell.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "StylishHaskell.Step.Imports.Tests"+    [ case01+    , case02+    , case03+    ]+++--------------------------------------------------------------------------------+input :: String+input = unlines+    [ "module Herp where"+    , ""+    , "import qualified Data.Map  as M"+    , "import Control.Monad"+    , "import       Data.Map     (lookup, (!), insert, Map)"+    , ""+    , "import Herp.Derp.Internals hiding (foo)"+    , ""+    , "herp = putStrLn \"import Hello world\""+    ]+++--------------------------------------------------------------------------------+case01 :: Test+case01 = testCase "case 01" $ expected @=? testStep (step Global) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import           Control.Monad"+        , "import           Data.Map            (Map, insert, lookup, (!))"+        , "import qualified Data.Map            as M"+        , ""+        , "import           Herp.Derp.Internals hiding (foo)"+        , ""+        , "herp = putStrLn \"import Hello world\""+        ]+++--------------------------------------------------------------------------------+case02 :: Test+case02 = testCase "case 02" $ expected @=? testStep (step Group) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import           Control.Monad"+        , "import           Data.Map      (Map, insert, lookup, (!))"+        , "import qualified Data.Map      as M"+        , ""+        , "import Herp.Derp.Internals hiding (foo)"+        , ""+        , "herp = putStrLn \"import Hello world\""+        ]+++--------------------------------------------------------------------------------+case03 :: Test+case03 = testCase "case 03" $ expected @=? testStep (step None) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import Control.Monad"+        , "import Data.Map (Map, insert, lookup, (!))"+        , "import qualified Data.Map as M"+        , ""+        , "import Herp.Derp.Internals hiding (foo)"+        , ""+        , "herp = putStrLn \"import Hello world\""+        ]
+ tests/StylishHaskell/Step/LanguagePragmas/Tests.hs view
@@ -0,0 +1,97 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.LanguagePragmas.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     ((@=?))+++--------------------------------------------------------------------------------+import           StylishHaskell.Step.LanguagePragmas+import           StylishHaskell.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "StylishHaskell.Step.LanguagePragmas.Tests"+    [ case01+    , case02+    , case03+    , case04+    ]+++--------------------------------------------------------------------------------+case01 :: Test+case01 = testCase "case 01" $+    expected @=? testStep (step Vertical False) input+  where+    input = unlines+        [ "{-# LANGUAGE ViewPatterns #-}"+        , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"+        , "{-# LANGUAGE ScopedTypeVariables #-}"+        , "module Main where"+        ]++    expected = unlines+        [ "{-# LANGUAGE ScopedTypeVariables #-}"+        , "{-# LANGUAGE TemplateHaskell     #-}"+        , "{-# LANGUAGE ViewPatterns        #-}"+        , "module Main where"+        ]+++--------------------------------------------------------------------------------+case02 :: Test+case02 = testCase "case 02" $+    expected @=? testStep (step Vertical True) input+  where+    input = unlines+        [ "{-# LANGUAGE BangPatterns #-}"+        , "{-# LANGUAGE ViewPatterns #-}"+        , "increment ((+ 1) -> x) = x"+        ]++    expected = unlines+        [ "{-# LANGUAGE ViewPatterns #-}"+        , "increment ((+ 1) -> x) = x"+        ]+++--------------------------------------------------------------------------------+case03 :: Test+case03 = testCase "case 03" $+    expected @=? testStep (step Vertical True) input+  where+    input = unlines+        [ "{-# LANGUAGE BangPatterns #-}"+        , "{-# LANGUAGE ViewPatterns #-}"+        , "increment x = case x of !_ -> x + 1"+        ]++    expected = unlines+        [ "{-# LANGUAGE BangPatterns #-}"+        , "increment x = case x of !_ -> x + 1"+        ]+++--------------------------------------------------------------------------------+case04 :: Test+case04 = testCase "case 04" $+    expected @=? testStep (step Compact False) input+  where+    input = unlines+        [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"+        , "    TemplateHaskell #-}"+        , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"+        ]++    expected = unlines+        [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " +++            "TemplateHaskell,"+        , "             TypeOperators, ViewPatterns #-}"+        ]
+ tests/StylishHaskell/Step/Tabs/Tests.hs view
@@ -0,0 +1,42 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.Tabs.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     ((@=?))+++--------------------------------------------------------------------------------+import           StylishHaskell.Step.Tabs+import           StylishHaskell.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "StylishHaskell.Step.Tabs.Tests" [case01]+++--------------------------------------------------------------------------------+case01 :: Test+case01 = testCase "case 01" $ expected @=? testStep (step 4) input+  where+    input = unlines+        [ "module Main"+        , "\t\twhere"+        , "data Foo"+        , "\t= Bar"+        , "    | Qux"+        ]++    expected = unlines+        [ "module Main"+        , "        where"+        , "data Foo"+        , "    = Bar"+        , "    | Qux"+        ]+
+ tests/StylishHaskell/Step/TrailingWhitespace/Tests.hs view
@@ -0,0 +1,37 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.TrailingWhitespace.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     ((@=?))+++--------------------------------------------------------------------------------+import           StylishHaskell.Step.TrailingWhitespace+import           StylishHaskell.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "StylishHaskell.Step.TrailingWhitespace.Tests" [case01]+++--------------------------------------------------------------------------------+case01 :: Test+case01 = testCase "case 01" $ expected @=? testStep step input+  where+    input = unlines+        [ "module Main where"+        , " "+        , "data Foo = Bar | Qux\t "+        ]++    expected = unlines+        [ "module Main where"+        , ""+        , "data Foo = Bar | Qux"+        ]
+ tests/StylishHaskell/Step/UnicodeSyntax/Tests.hs view
@@ -0,0 +1,38 @@+--------------------------------------------------------------------------------+module StylishHaskell.Step.UnicodeSyntax.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     ((@=?))+++--------------------------------------------------------------------------------+import           StylishHaskell.Step.UnicodeSyntax+import           StylishHaskell.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "StylishHaskell.Step.UnicodeSyntax.Tests"+    [ case01+    ]+++--------------------------------------------------------------------------------+case01 :: Test+case01 = testCase "case 01" $ expected @=? testStep (step True) input+  where+    input = unlines+        [ "sort :: Ord a => [a] -> [a]"+        , "sort _ = []"+        ]++    expected = unlines+        [ "{-# LANGUAGE UnicodeSyntax #-}"+        , "sort ∷ Ord a ⇒ [a] → [a]"+        , "sort _ = []"+        ]
− tests/StylishHaskell/Tabs/Tests.hs 
@@ -1,42 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Tabs.Tests-    ( tests-    ) where------------------------------------------------------------------------------------import           Test.Framework                 (Test, testGroup)-import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     ((@=?))------------------------------------------------------------------------------------import           StylishHaskell.Tabs-import           StylishHaskell.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "StylishHaskell.Tabs.Tests" [case01]------------------------------------------------------------------------------------case01 :: Test-case01 = testCase "case 01" $ expected @=? testStylish stylish input-  where-    input = unlines-        [ "module Main"-        , "\t\twhere"-        , "data Foo"-        , "\t= Bar"-        , "    | Qux"-        ]--    expected = unlines-        [ "module Main"-        , "        where"-        , "data Foo"-        , "    = Bar"-        , "    | Qux"-        ]-
tests/StylishHaskell/Tests/Util.hs view
@@ -1,17 +1,17 @@ module StylishHaskell.Tests.Util-    ( testStylish+    ( testStep     ) where   -------------------------------------------------------------------------------- import           StylishHaskell.Parse-import           StylishHaskell.Stylish+import           StylishHaskell.Step   ---------------------------------------------------------------------------------testStylish :: Stylish -> String -> String-testStylish stylish str = case parseModule Nothing str of+testStep :: Step -> String -> String+testStep step str = case parseModule Nothing str of     Left err      -> error err-    Right module' -> unlines $ stylish ls module'+    Right module' -> unlines $ stepFilter step ls module'   where     ls = lines str
− tests/StylishHaskell/TrailingWhitespace/Tests.hs 
@@ -1,37 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.TrailingWhitespace.Tests-    ( tests-    ) where------------------------------------------------------------------------------------import           Test.Framework                 (Test, testGroup)-import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     ((@=?))------------------------------------------------------------------------------------import           StylishHaskell.TrailingWhitespace-import           StylishHaskell.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "StylishHaskell.TrailingWhitespace.Tests" [case01]------------------------------------------------------------------------------------case01 :: Test-case01 = testCase "case 01" $ expected @=? testStylish stylish input-  where-    input = unlines-        [ "module Main where"-        , " "-        , "data Foo = Bar | Qux\t "-        ]--    expected = unlines-        [ "module Main where"-        , ""-        , "data Foo = Bar | Qux"-        ]
tests/TestSuite.hs view
@@ -5,21 +5,23 @@   ---------------------------------------------------------------------------------import           Test.Framework               (defaultMain)+import           Test.Framework                               (defaultMain)   ---------------------------------------------------------------------------------import qualified StylishHaskell.Imports.Tests-import qualified StylishHaskell.LanguagePragmas.Tests-import qualified StylishHaskell.Tabs.Tests-import qualified StylishHaskell.TrailingWhitespace.Tests+import qualified StylishHaskell.Step.Imports.Tests+import qualified StylishHaskell.Step.LanguagePragmas.Tests+import qualified StylishHaskell.Step.Tabs.Tests+import qualified StylishHaskell.Step.TrailingWhitespace.Tests+import qualified StylishHaskell.Step.UnicodeSyntax.Tests   -------------------------------------------------------------------------------- main :: IO () main = defaultMain-    [ StylishHaskell.Imports.Tests.tests-    , StylishHaskell.LanguagePragmas.Tests.tests-    , StylishHaskell.Tabs.Tests.tests-    , StylishHaskell.TrailingWhitespace.Tests.tests+    [ StylishHaskell.Step.Imports.Tests.tests+    , StylishHaskell.Step.LanguagePragmas.Tests.tests+    , StylishHaskell.Step.Tabs.Tests.tests+    , StylishHaskell.Step.TrailingWhitespace.Tests.tests+    , StylishHaskell.Step.UnicodeSyntax.Tests.tests     ]