packages feed

stylish-haskell 0.4.0.0 → 0.5.0.0

raw patch · 49 files changed

+1757/−1681 lines, 49 filesdep +stylish-haskell

Dependencies added: stylish-haskell

Files

− .stylish-haskell.yaml 
@@ -1,71 +0,0 @@-# 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--  # 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-  #     # Haskell report.-  #     spaces: 8--  # Remove trailing whitespace-  - trailing_whitespace: {}--# A common setting is the number of columns (parts of) code will be wrapped-# to. Different steps take this into account. Default: 80.-columns: 80--# Sometimes, language extensions are specified in a cabal file or from the-# command line instead of using language pragmas in the file. stylish-haskell-# needs to be aware of these, so it can parse the file correctly.-#-# No language extensions are enabled by default.-# language_extensions:-  # - TemplateHaskell-  # - QuasiQuotes
+ data/stylish-haskell.yaml view
@@ -0,0 +1,71 @@+# 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++  # 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+  #     # Haskell report.+  #     spaces: 8++  # Remove trailing whitespace+  - trailing_whitespace: {}++# A common setting is the number of columns (parts of) code will be wrapped+# to. Different steps take this into account. Default: 80.+columns: 80++# Sometimes, language extensions are specified in a cabal file or from the+# command line instead of using language pragmas in the file. stylish-haskell+# needs to be aware of these, so it can parse the file correctly.+#+# No language extensions are enabled by default.+# language_extensions:+  # - TemplateHaskell+  # - QuasiQuotes
+ src/Language/Haskell/Stylish.hs view
@@ -0,0 +1,92 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish+    ( -- * Run+      runSteps+      -- * Steps+    , imports+    , languagePragmas+    , records+    , tabs+    , trailingWhitespace+    , unicodeSyntax+      -- ** Data types+    , Imports.Align (..)+    , LanguagePragmas.Style (..)+      -- ** Helpers+    , stepName+      -- * Config+    , module Language.Haskell.Stylish.Config+      -- * Misc+    , module Language.Haskell.Stylish.Verbose+    , version+    , Lines+    , Step+    ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Control.Monad (foldM)+++--------------------------------------------------------------------------------+import Language.Haskell.Stylish.Config+import Language.Haskell.Stylish.Step+import Language.Haskell.Stylish.Verbose+import Language.Haskell.Stylish.Parse+import Paths_stylish_haskell  (version)+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+import qualified Language.Haskell.Stylish.Step.Tabs as Tabs+import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace+import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax+++--------------------------------------------------------------------------------+imports :: Int -- ^ columns+        -> Imports.Align+        -> Step+imports = Imports.step+++--------------------------------------------------------------------------------+languagePragmas :: Int -- ^ columns+                -> LanguagePragmas.Style+                -> Bool -- ^ remove redundant?+                -> Step+languagePragmas = LanguagePragmas.step+++--------------------------------------------------------------------------------+records :: Step+records = Records.step+++--------------------------------------------------------------------------------+tabs :: Int -- ^ number of spaces+     -> Step+tabs = Tabs.step+++--------------------------------------------------------------------------------+trailingWhitespace :: Step+trailingWhitespace = TrailingWhitespace.step+++--------------------------------------------------------------------------------+unicodeSyntax :: Bool -- ^ add language pragma?+              -> Step+unicodeSyntax = UnicodeSyntax.step+++--------------------------------------------------------------------------------+runStep :: Extensions -> Maybe FilePath -> Lines -> Step -> Either String Lines+runStep exts mfp ls step =+    stepFilter step ls <$> parseModule exts mfp (unlines ls)+++--------------------------------------------------------------------------------+runSteps :: Extensions -> Maybe FilePath -> [Step] -> Lines+         -> Either String Lines+runSteps exts mfp steps ls = foldM (runStep exts mfp) ls steps
+ src/Language/Haskell/Stylish/Block.hs view
@@ -0,0 +1,78 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Block+    ( Block (..)+    , LineBlock+    , SpanBlock+    , blockLength+    , linesFromSrcSpan+    , spanFromSrcSpan+    , moveBlock+    , adjacent+    , merge+    , overlapping+    ) where+++--------------------------------------------------------------------------------+import           Control.Arrow                   (arr, (&&&), (>>>))+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+-- | Indicates a line span+data Block a = Block+    { blockStart :: Int+    , blockEnd   :: Int+    } deriving (Eq, Ord, Show)+++--------------------------------------------------------------------------------+type LineBlock = Block String+++--------------------------------------------------------------------------------+type SpanBlock = Block Char+++--------------------------------------------------------------------------------+blockLength :: Block a -> Int+blockLength (Block start end) = end - start + 1+++--------------------------------------------------------------------------------+linesFromSrcSpan :: H.SrcSpanInfo -> LineBlock+linesFromSrcSpan = H.srcInfoSpan >>>+    H.srcSpanStartLine &&& H.srcSpanEndLine >>>+    arr (uncurry 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 a -> Block a -> Bool+adjacent b1 b2 = follows b1 b2 || follows b2 b1+  where+    follows (Block _ e1) (Block s2 _) = e1 + 1 == s2+++--------------------------------------------------------------------------------+merge :: Block a -> Block a -> Block a+merge (Block s1 e1) (Block s2 e2) = Block (min s1 s2) (max e1 e2)+++--------------------------------------------------------------------------------+overlapping :: [Block a] -> Bool+overlapping blocks =+    any (uncurry overlapping') $ zip blocks (drop 1 blocks)+  where+    overlapping' (Block _ e1) (Block s2 _) = e1 >= s2
+ src/Language/Haskell/Stylish/Config.hs view
@@ -0,0 +1,199 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Language.Haskell.Stylish.Config+    ( Extensions+    , Config (..)+    , defaultConfigFilePath+    , configFilePath+    , loadConfig+    ) where+++--------------------------------------------------------------------------------+import           Control.Applicative                    (pure, (<$>), (<*>))+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           Language.Haskell.Stylish.Step+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+import qualified Language.Haskell.Stylish.Step.Tabs               as Tabs+import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace+import qualified Language.Haskell.Stylish.Step.UnicodeSyntax      as UnicodeSyntax+import           Language.Haskell.Stylish.Verbose+++--------------------------------------------------------------------------------+type Extensions = [String]+++--------------------------------------------------------------------------------+data Config = Config+    { configSteps              :: [Step]+    , configColumns            :: Int+    , configLanguageExtensions :: [String]+    }+++--------------------------------------------------------------------------------+instance FromJSON Config where+    parseJSON = parseConfig+++--------------------------------------------------------------------------------+emptyConfig :: Config+emptyConfig = Config [] 80 []+++--------------------------------------------------------------------------------+configFileName :: String+configFileName = ".stylish-haskell.yaml"+++--------------------------------------------------------------------------------+defaultConfigFilePath :: IO FilePath+defaultConfigFilePath = getDataFileName "data/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 $+                    "Language.Haskell.Stylish.Config.loadConfig: " ++ err+                Right config -> return config+++--------------------------------------------------------------------------------+parseConfig :: A.Value -> A.Parser Config+parseConfig (A.Object o) = do+    -- First load the config without the actual steps+    config <- Config+        <$> pure []+        <*> (o A..:? "columns"             A..!= 80)+        <*> (o A..:? "language_extensions" A..!= [])++    -- Then fill in the steps based on the partial config we already have+    steps <- (o A..:  "steps" >>= fmap concat . mapM (parseSteps config))+    return config {configSteps = steps}+parseConfig _            = mzero+++--------------------------------------------------------------------------------+catalog :: Map String (Config -> A.Object -> A.Parser Step)+catalog = M.fromList+    [ ("imports",             parseImports)+    , ("language_pragmas",    parseLanguagePragmas)+    , ("records",             parseRecords)+    , ("tabs",                parseTabs)+    , ("trailing_whitespace", parseTrailingWhitespace)+    , ("unicode_syntax",      parseUnicodeSyntax)+    ]+++--------------------------------------------------------------------------------+parseSteps :: Config -> A.Value -> A.Parser [Step]+parseSteps config 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 config 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 :: Config -> A.Object -> A.Parser Step+parseImports config o = Imports.step+    <$> pure (configColumns config)+    <*> (o A..:? "align" >>= parseEnum aligns Imports.Global)+  where+    aligns =+        [ ("global", Imports.Global)+        , ("group",  Imports.Group)+        , ("none",   Imports.None)+        ]+++--------------------------------------------------------------------------------+parseLanguagePragmas :: Config -> A.Object -> A.Parser Step+parseLanguagePragmas config o = LanguagePragmas.step+    <$> pure (configColumns config)+    <*> (o A..:? "style" >>= parseEnum styles LanguagePragmas.Vertical)+    <*> o A..:? "remove_redundant" A..!= True+  where+    styles =+        [ ("vertical", LanguagePragmas.Vertical)+        , ("compact",  LanguagePragmas.Compact)+        ]+++--------------------------------------------------------------------------------+parseRecords :: Config -> A.Object -> A.Parser Step+parseRecords _ _ = return Records.step+++--------------------------------------------------------------------------------+parseTabs :: Config -> A.Object -> A.Parser Step+parseTabs _ o = Tabs.step+    <$> o A..:? "spaces" A..!= 8+++--------------------------------------------------------------------------------+parseTrailingWhitespace :: Config -> A.Object -> A.Parser Step+parseTrailingWhitespace _ _ = return TrailingWhitespace.step+++--------------------------------------------------------------------------------+parseUnicodeSyntax :: Config -> A.Object -> A.Parser Step+parseUnicodeSyntax _ o = UnicodeSyntax.step+    <$> o A..:? "add_language_pragma" A..!= True
+ src/Language/Haskell/Stylish/Editor.hs view
@@ -0,0 +1,101 @@+--------------------------------------------------------------------------------+-- | This module provides you with a line-based editor. It's main feature is+-- that you can specify multiple changes at the same time, e.g.:+--+-- > [deleteLine 3, changeLine 4 ["Foo"]]+--+-- when this is evaluated, we take into account that 4th line will become the+-- 3rd line before it needs changing.+module Language.Haskell.Stylish.Editor+    ( Change+    , applyChanges++    , change+    , changeLine+    , delete+    , deleteLine+    , insert+    ) where+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Block+++--------------------------------------------------------------------------------+-- | Changes the lines indicated by the 'Block' into the given 'Lines'+data Change a = Change+    { changeBlock :: Block a+    , changeLines :: ([a] -> [a])+    }+++--------------------------------------------------------------------------------+moveChange :: Int -> Change a -> Change a+moveChange offset (Change block ls) = Change (moveBlock offset block) ls+++--------------------------------------------------------------------------------+applyChanges :: [Change a] -> [a] -> [a]+applyChanges changes+    | overlapping blocks = error $+        "Language.Haskell.Stylish.Editor.applyChanges: " +++        "refusing to make overlapping changes"+    | otherwise          = go 1 changes+  where+    blocks = map changeBlock changes++    go _ []                ls = ls+    go n (ch : chs) ls =+        -- Divide the remaining lines into:+        --+        -- > pre+        -- > old  (lines that are affected by the change)+        -- > post+        --+        -- And generate:+        --+        -- > pre+        -- > new+        -- > (recurse)+        --+        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] -> [a]) -> Change a+change = Change+++--------------------------------------------------------------------------------+-- | Change a single line for some other lines+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 $ const []+++--------------------------------------------------------------------------------+-- | Delete a single line+deleteLine :: Int -> Change a+deleteLine start = delete (Block start start)+++--------------------------------------------------------------------------------+-- | Insert something /before/ the given lines+insert :: Int -> [a] -> Change a+insert start = Change (Block start (start - 1)) . const
+ src/Language/Haskell/Stylish/Parse.hs view
@@ -0,0 +1,64 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Parse+    ( parseModule+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad.Error             (throwError)+import           Data.Maybe                      (fromMaybe)+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Config+import           Language.Haskell.Stylish.Step+++--------------------------------------------------------------------------------+-- | Filter out lines which use CPP macros+unCpp :: String -> String+unCpp = unlines . map unCpp' . lines+  where+    unCpp' ('#' : _) = ""+    unCpp' xs        = xs+++--------------------------------------------------------------------------------+-- | If the given string is prefixed with an UTF-8 Byte Order Mark, drop it+-- because haskell-src-exts can't handle it.+dropBom :: String -> String+dropBom ('\xfeff' : str) = str+dropBom str              = str+++--------------------------------------------------------------------------------+-- | Read an extension name from a string+parseExtension :: String -> Either String H.Extension+parseExtension str = case reads str of+    [(x, "")] -> return x+    _         -> throwError $ "Unknown extension: " ++ str+++--------------------------------------------------------------------------------+-- | Abstraction over HSE's parsing+parseModule :: Extensions -> Maybe FilePath -> String -> Either String Module+parseModule extraExts mfp string = do+    -- Determine the extensions: those specified in the file and the extra ones +    extraExts' <- mapM parseExtension extraExts+    let fileExts = fromMaybe [] $ H.readExtensions string+        exts     = fileExts ++ extraExts'++        -- Parsing options...+        fp       = fromMaybe "<unknown>" mfp+        mode     = H.defaultParseMode+            {H.extensions = exts, H.fixities = Nothing}++        -- Preprocessing+        string'  = dropBom $ (if H.CPP `elem` exts then unCpp else id) $ string++    case H.parseModuleWithComments mode string' of+        H.ParseOk md -> return md+        err          -> throwError $+            "Language.Haskell.Stylish.Parse.parseModule: could not parse " +++            fp ++ ": " ++ show err
+ src/Language/Haskell/Stylish/Step.hs view
@@ -0,0 +1,32 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.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/Language/Haskell/Stylish/Step/Imports.hs view
@@ -0,0 +1,174 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.Imports+    ( Align (..)+    , step+    ) where+++--------------------------------------------------------------------------------+import           Control.Arrow                   ((&&&))+import           Data.Char                       (isAlpha, toLower)+import           Data.List                       (intercalate, sortBy)+import           Data.Maybe                      (isJust, maybeToList)+import           Data.Ord                        (comparing)+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Block+import           Language.Haskell.Stylish.Editor+import           Language.Haskell.Stylish.Step+import           Language.Haskell.Stylish.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 (map toLower . 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+++--------------------------------------------------------------------------------+-- | By default, haskell-src-exts pretty-prints+--+-- > import Foo (Bar(..))+--+-- but we want+--+-- > import Foo (Bar (..))+--+-- instead.+prettyImportSpec :: H.ImportSpec l -> String+prettyImportSpec (H.IThingAll  _ n)     = H.prettyPrint n ++ " (..)"+prettyImportSpec (H.IThingWith _ n cns) = H.prettyPrint n ++ " (" +++    intercalate ", " (map H.prettyPrint cns) ++ ")"+prettyImportSpec x                      = H.prettyPrint x+++--------------------------------------------------------------------------------+prettyImport :: Int -> Bool -> Bool -> Int -> H.ImportDecl l -> String+prettyImport columns padQualified padName longest imp =+    intercalate "\n" $+    wrap columns base (length base + 2) $+    (if hiding then ("hiding" :) else id) $+    withInit (++ ",") $+    withHead ("(" ++) $+    withLast (++ ")") $+    map prettyImportSpec $+    importSpecs+  where+    base = unwords $ concat+         [ ["import"]+         , qualified+         , [(if hasExtras && padName then padRight longest else id)+            (importName imp)]+         , ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp]+         ]++    (hiding, importSpecs) = case H.importSpecs imp of+        Just (H.ImportSpecList _ h l) -> (h, l)+        _                             -> (False, [])++    hasExtras = isJust (H.importAs imp) || isJust (H.importSpecs imp)++    qualified+        | H.importQualified imp = ["qualified"]+        | padQualified          = ["         "]+        | otherwise             = []+++--------------------------------------------------------------------------------+prettyImportGroup :: Int -> Align -> Int -> [H.ImportDecl LineBlock] -> Lines+prettyImportGroup columns align longest imps =+    map (prettyImport columns 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 :: Int -> Align -> Step+step columns = makeStep "Imports" . step' columns+++--------------------------------------------------------------------------------+step' :: Int -> Align -> Lines -> Module -> Lines+step' columns align ls (module', _) = flip applyChanges ls+    [ change block (const $ prettyImportGroup columns align longest importGroup)+    | (block, importGroup) <- groups+    ]+  where+    imps    = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module'+    longest = longestImport imps+    groups  = groupAdjacent imps
+ src/Language/Haskell/Stylish/Step/LanguagePragmas.hs view
@@ -0,0 +1,119 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.LanguagePragmas+    ( Style (..)+    , step++      -- * Utilities+    , addLanguagePragma+    ) where+++--------------------------------------------------------------------------------+import           Data.List                       (nub, sort)+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Block+import           Language.Haskell.Stylish.Editor+import           Language.Haskell.Stylish.Step+import           Language.Haskell.Stylish.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)+++--------------------------------------------------------------------------------+verticalPragmas :: [String] -> Lines+verticalPragmas pragmas' =+    [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}"+    | pragma <- pragmas'+    ]+  where+    longest = maximum $ map length pragmas'+++--------------------------------------------------------------------------------+compactPragmas :: Int -> [String] -> Lines+compactPragmas columns pragmas' = wrap columns "{-# LANGUAGE" 13 $+    map (++ ",") (init pragmas') ++ [last pragmas', "#-}"]+++--------------------------------------------------------------------------------+prettyPragmas :: Int -> Style -> [String] -> Lines+prettyPragmas _       Vertical = verticalPragmas+prettyPragmas columns Compact  = compactPragmas columns+++--------------------------------------------------------------------------------+step :: Int -> Style -> Bool -> Step+step columns style = makeStep "LanguagePragmas" . step' columns style+++--------------------------------------------------------------------------------+step' :: Int -> Style -> Bool -> Lines -> Module -> Lines+step' columns 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 columns 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/Language/Haskell/Stylish/Step/Records.hs view
@@ -0,0 +1,71 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.Records+    ( step+    ) where+++--------------------------------------------------------------------------------+import           Data.Char                       (isSpace)+import           Data.List                       (nub)+import qualified Language.Haskell.Exts.Annotated as H+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Editor+import           Language.Haskell.Stylish.Step+import           Language.Haskell.Stylish.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
+ src/Language/Haskell/Stylish/Step/Tabs.hs view
@@ -0,0 +1,21 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.Tabs+    ( step+    ) where+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.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/Language/Haskell/Stylish/Step/TrailingWhitespace.hs view
@@ -0,0 +1,22 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.TrailingWhitespace+    ( step+    ) where+++--------------------------------------------------------------------------------+import           Data.Char           (isSpace)+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Step+++--------------------------------------------------------------------------------+dropTrailingWhitespace :: String -> String+dropTrailingWhitespace = reverse . dropWhile isSpace . reverse+++--------------------------------------------------------------------------------+step :: Step+step = makeStep "TrailingWhitespace" $ \ls _ -> map dropTrailingWhitespace ls
+ src/Language/Haskell/Stylish/Step/UnicodeSyntax.hs view
@@ -0,0 +1,115 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.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           Language.Haskell.Stylish.Block+import           Language.Haskell.Stylish.Editor+import           Language.Haskell.Stylish.Step+import           Language.Haskell.Stylish.Step.LanguagePragmas (addLanguagePragma)+import           Language.Haskell.Stylish.Util+++--------------------------------------------------------------------------------+unicodeReplacements :: Map String String+unicodeReplacements = M.fromList+    [ ("::", "∷")+    , ("=>", "⇒")+    , ("->", "→")+    ]+++--------------------------------------------------------------------------------+replaceAll :: [(Int, [(Int, String)])] -> [Change String]+replaceAll = map changeLine'+  where+    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+            ]+++--------------------------------------------------------------------------------+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+    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+    perLine = sort $ groupPerLine $+        typeSigs module' ls +++        contexts module' ls +++        typeFuns module' ls
+ src/Language/Haskell/Stylish/Util.hs view
@@ -0,0 +1,92 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Util+    ( nameToString+    , indent+    , padRight+    , everything+    , infoPoints+    , wrap++    , withHead+    , withLast+    , withInit+    ) 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+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Step+++--------------------------------------------------------------------------------+nameToString :: H.Name l -> String+nameToString (H.Ident _ str)  = str+nameToString (H.Symbol _ str) = str+++--------------------------------------------------------------------------------+indent :: Int -> String -> String+indent len str = replicate len ' ' ++ str+++--------------------------------------------------------------------------------+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 ind 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], indent ind str, ind + len)+        | otherwise         = (ls, curr ++ " " ++ str, width')+      where+        len    = length str+        width' = width + 1 + len+++--------------------------------------------------------------------------------+withHead :: (a -> a) -> [a] -> [a]+withHead _ []       = []+withHead f (x : xs) = f x : xs+++--------------------------------------------------------------------------------+withLast :: (a -> a) -> [a] -> [a]+withLast _ []       = []+withLast f (x : []) = [f x]+withLast f (x : xs) = x : withLast f xs+++--------------------------------------------------------------------------------+withInit :: (a -> a) -> [a] -> [a]+withInit _ []       = []+withInit _ (x : []) = [x]+withInit f (x : xs) = f x : withInit f xs
+ src/Language/Haskell/Stylish/Verbose.hs view
@@ -0,0 +1,20 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Verbose+    ( Verbose+    , makeVerbose+    ) where+++--------------------------------------------------------------------------------+import           System.IO (hPutStrLn, stderr)+++--------------------------------------------------------------------------------+type Verbose = String -> IO ()+++--------------------------------------------------------------------------------+makeVerbose :: Bool -> Verbose+makeVerbose verbose+    | verbose   = hPutStrLn stderr+    | otherwise = const $ return ()
src/Main.hs view
@@ -16,11 +16,7 @@   ---------------------------------------------------------------------------------import           Paths_stylish_haskell  (version)-import           StylishHaskell-import           StylishHaskell.Config-import           StylishHaskell.Step-import           StylishHaskell.Verbose+import           Language.Haskell.Stylish   --------------------------------------------------------------------------------
− src/StylishHaskell.hs 
@@ -1,28 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell-    ( runStep-    , runSteps-    ) where------------------------------------------------------------------------------------import           Control.Applicative   ((<$>))-import           Control.Monad         (foldM)------------------------------------------------------------------------------------import           StylishHaskell.Config-import           StylishHaskell.Parse-import           StylishHaskell.Step------------------------------------------------------------------------------------runStep :: Extensions -> Maybe FilePath -> Lines -> Step -> Either String Lines-runStep exts mfp ls step =-    stepFilter step ls <$> parseModule exts mfp (unlines ls)------------------------------------------------------------------------------------runSteps :: Extensions -> Maybe FilePath -> [Step] -> Lines-         -> Either String Lines-runSteps exts mfp steps ls = foldM (runStep exts mfp) ls steps
− src/StylishHaskell/Block.hs 
@@ -1,78 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Block-    ( Block (..)-    , LineBlock-    , SpanBlock-    , blockLength-    , linesFromSrcSpan-    , spanFromSrcSpan-    , moveBlock-    , adjacent-    , merge-    , overlapping-    ) where------------------------------------------------------------------------------------import           Control.Arrow                   (arr, (&&&), (>>>))-import qualified Language.Haskell.Exts.Annotated as H-------------------------------------------------------------------------------------- | Indicates a line span-data Block a = Block-    { blockStart :: Int-    , blockEnd   :: Int-    } deriving (Eq, Ord, Show)------------------------------------------------------------------------------------type LineBlock = Block String------------------------------------------------------------------------------------type SpanBlock = Block Char------------------------------------------------------------------------------------blockLength :: Block a -> Int-blockLength (Block start end) = end - start + 1------------------------------------------------------------------------------------linesFromSrcSpan :: H.SrcSpanInfo -> LineBlock-linesFromSrcSpan = H.srcInfoSpan >>>-    H.srcSpanStartLine &&& H.srcSpanEndLine >>>-    arr (uncurry 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 a -> Block a -> Bool-adjacent b1 b2 = follows b1 b2 || follows b2 b1-  where-    follows (Block _ e1) (Block s2 _) = e1 + 1 == s2------------------------------------------------------------------------------------merge :: Block a -> Block a -> Block a-merge (Block s1 e1) (Block s2 e2) = Block (min s1 s2) (max e1 e2)------------------------------------------------------------------------------------overlapping :: [Block a] -> Bool-overlapping blocks =-    any (uncurry overlapping') $ zip blocks (drop 1 blocks)-  where-    overlapping' (Block _ e1) (Block s2 _) = e1 >= s2
− src/StylishHaskell/Config.hs 
@@ -1,199 +0,0 @@----------------------------------------------------------------------------------{-# LANGUAGE OverloadedStrings #-}-module StylishHaskell.Config-    ( Extensions-    , Config (..)-    , defaultConfigFilePath-    , configFilePath-    , loadConfig-    ) where------------------------------------------------------------------------------------import           Control.Applicative                    (pure, (<$>), (<*>))-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.Records            as Records-import qualified StylishHaskell.Step.Tabs               as Tabs-import qualified StylishHaskell.Step.TrailingWhitespace as TrailingWhitespace-import qualified StylishHaskell.Step.UnicodeSyntax      as UnicodeSyntax-import           StylishHaskell.Verbose------------------------------------------------------------------------------------type Extensions = [String]------------------------------------------------------------------------------------data Config = Config-    { configSteps              :: [Step]-    , configColumns            :: Int-    , configLanguageExtensions :: [String]-    }------------------------------------------------------------------------------------instance FromJSON Config where-    parseJSON = parseConfig------------------------------------------------------------------------------------emptyConfig :: Config-emptyConfig = Config [] 80 []------------------------------------------------------------------------------------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) = do-    -- First load the config without the actual steps-    config <- Config-        <$> pure []-        <*> (o A..:? "columns"             A..!= 80)-        <*> (o A..:? "language_extensions" A..!= [])--    -- Then fill in the steps based on the partial config we already have-    steps <- (o A..:  "steps" >>= fmap concat . mapM (parseSteps config))-    return config {configSteps = steps}-parseConfig _            = mzero------------------------------------------------------------------------------------catalog :: Map String (Config -> A.Object -> A.Parser Step)-catalog = M.fromList-    [ ("imports",             parseImports)-    , ("language_pragmas",    parseLanguagePragmas)-    , ("records",             parseRecords)-    , ("tabs",                parseTabs)-    , ("trailing_whitespace", parseTrailingWhitespace)-    , ("unicode_syntax",      parseUnicodeSyntax)-    ]------------------------------------------------------------------------------------parseSteps :: Config -> A.Value -> A.Parser [Step]-parseSteps config 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 config 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 :: Config -> A.Object -> A.Parser Step-parseImports config o = Imports.step-    <$> pure (configColumns config)-    <*> (o A..:? "align" >>= parseEnum aligns Imports.Global)-  where-    aligns =-        [ ("global", Imports.Global)-        , ("group",  Imports.Group)-        , ("none",   Imports.None)-        ]------------------------------------------------------------------------------------parseLanguagePragmas :: Config -> A.Object -> A.Parser Step-parseLanguagePragmas config o = LanguagePragmas.step-    <$> pure (configColumns config)-    <*> (o A..:? "style" >>= parseEnum styles LanguagePragmas.Vertical)-    <*> o A..:? "remove_redundant" A..!= True-  where-    styles =-        [ ("vertical", LanguagePragmas.Vertical)-        , ("compact",  LanguagePragmas.Compact)-        ]------------------------------------------------------------------------------------parseRecords :: Config -> A.Object -> A.Parser Step-parseRecords _ _ = return Records.step------------------------------------------------------------------------------------parseTabs :: Config -> A.Object -> A.Parser Step-parseTabs _ o = Tabs.step-    <$> o A..:? "spaces" A..!= 8------------------------------------------------------------------------------------parseTrailingWhitespace :: Config -> A.Object -> A.Parser Step-parseTrailingWhitespace _ _ = return TrailingWhitespace.step------------------------------------------------------------------------------------parseUnicodeSyntax :: Config -> A.Object -> A.Parser Step-parseUnicodeSyntax _ o = UnicodeSyntax.step-    <$> o A..:? "add_language_pragma" A..!= True
− src/StylishHaskell/Editor.hs 
@@ -1,101 +0,0 @@------------------------------------------------------------------------------------ | This module provides you with a line-based editor. It's main feature is--- that you can specify multiple changes at the same time, e.g.:------ > [deleteLine 3, changeLine 4 ["Foo"]]------ when this is evaluated, we take into account that 4th line will become the--- 3rd line before it needs changing.-module StylishHaskell.Editor-    ( Change-    , applyChanges--    , change-    , changeLine-    , delete-    , deleteLine-    , insert-    ) where------------------------------------------------------------------------------------import           StylishHaskell.Block-------------------------------------------------------------------------------------- | Changes the lines indicated by the 'Block' into the given 'Lines'-data Change a = Change-    { changeBlock :: Block a-    , changeLines :: ([a] -> [a])-    }------------------------------------------------------------------------------------moveChange :: Int -> Change a -> Change a-moveChange offset (Change block ls) = Change (moveBlock offset block) ls------------------------------------------------------------------------------------applyChanges :: [Change a] -> [a] -> [a]-applyChanges changes-    | overlapping blocks = error $-        "StylishHaskell.Editor.applyChanges: " ++-        "refusing to make overlapping changes"-    | otherwise          = go 1 changes-  where-    blocks = map changeBlock changes--    go _ []                ls = ls-    go n (ch : chs) ls =-        -- Divide the remaining lines into:-        ---        -- > pre-        -- > old  (lines that are affected by the change)-        -- > post-        ---        -- And generate:-        ---        -- > pre-        -- > new-        -- > (recurse)-        ---        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] -> [a]) -> Change a-change = Change-------------------------------------------------------------------------------------- | Change a single line for some other lines-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 $ const []-------------------------------------------------------------------------------------- | Delete a single line-deleteLine :: Int -> Change a-deleteLine start = delete (Block start start)-------------------------------------------------------------------------------------- | Insert something /before/ the given lines-insert :: Int -> [a] -> Change a-insert start = Change (Block start (start - 1)) . const
− src/StylishHaskell/Parse.hs 
@@ -1,64 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Parse-    ( parseModule-    ) where------------------------------------------------------------------------------------import           Control.Monad.Error             (throwError)-import           Data.Maybe                      (fromMaybe)-import qualified Language.Haskell.Exts.Annotated as H------------------------------------------------------------------------------------import           StylishHaskell.Config-import           StylishHaskell.Step-------------------------------------------------------------------------------------- | Filter out lines which use CPP macros-unCpp :: String -> String-unCpp = unlines . map unCpp' . lines-  where-    unCpp' ('#' : _) = ""-    unCpp' xs        = xs-------------------------------------------------------------------------------------- | If the given string is prefixed with an UTF-8 Byte Order Mark, drop it--- because haskell-src-exts can't handle it.-dropBom :: String -> String-dropBom ('\xfeff' : str) = str-dropBom str              = str-------------------------------------------------------------------------------------- | Read an extension name from a string-parseExtension :: String -> Either String H.Extension-parseExtension str = case reads str of-    [(x, "")] -> return x-    _         -> throwError $ "Unknown extension: " ++ str-------------------------------------------------------------------------------------- | Abstraction over HSE's parsing-parseModule :: Extensions -> Maybe FilePath -> String -> Either String Module-parseModule extraExts mfp string = do-    -- Determine the extensions: those specified in the file and the extra ones -    extraExts' <- mapM parseExtension extraExts-    let fileExts = fromMaybe [] $ H.readExtensions string-        exts     = fileExts ++ extraExts'--        -- Parsing options...-        fp       = fromMaybe "<unknown>" mfp-        mode     = H.defaultParseMode-            {H.extensions = exts, H.fixities = Nothing}--        -- Preprocessing-        string'  = dropBom $ (if H.CPP `elem` exts then unCpp else id) $ string--    case H.parseModuleWithComments mode string' of-        H.ParseOk md -> return md-        err          -> throwError $-            "StylishHaskell.Parse.parseModule: could not parse " ++-            fp ++ ": " ++ show err
− src/StylishHaskell/Step.hs 
@@ -1,32 +0,0 @@----------------------------------------------------------------------------------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 
@@ -1,174 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Step.Imports-    ( Align (..)-    , step-    ) where------------------------------------------------------------------------------------import           Control.Arrow                   ((&&&))-import           Data.Char                       (isAlpha, toLower)-import           Data.List                       (intercalate, 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 (map toLower . 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-------------------------------------------------------------------------------------- | By default, haskell-src-exts pretty-prints------ > import Foo (Bar(..))------ but we want------ > import Foo (Bar (..))------ instead.-prettyImportSpec :: H.ImportSpec l -> String-prettyImportSpec (H.IThingAll  _ n)     = H.prettyPrint n ++ " (..)"-prettyImportSpec (H.IThingWith _ n cns) = H.prettyPrint n ++ " (" ++-    intercalate ", " (map H.prettyPrint cns) ++ ")"-prettyImportSpec x                      = H.prettyPrint x------------------------------------------------------------------------------------prettyImport :: Int -> Bool -> Bool -> Int -> H.ImportDecl l -> String-prettyImport columns padQualified padName longest imp =-    intercalate "\n" $-    wrap columns base (length base + 2) $-    (if hiding then ("hiding" :) else id) $-    withInit (++ ",") $-    withHead ("(" ++) $-    withLast (++ ")") $-    map prettyImportSpec $-    importSpecs-  where-    base = unwords $ concat-         [ ["import"]-         , qualified-         , [(if hasExtras && padName then padRight longest else id)-            (importName imp)]-         , ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp]-         ]--    (hiding, importSpecs) = case H.importSpecs imp of-        Just (H.ImportSpecList _ h l) -> (h, l)-        _                             -> (False, [])--    hasExtras = isJust (H.importAs imp) || isJust (H.importSpecs imp)--    qualified-        | H.importQualified imp = ["qualified"]-        | padQualified          = ["         "]-        | otherwise             = []------------------------------------------------------------------------------------prettyImportGroup :: Int -> Align -> Int -> [H.ImportDecl LineBlock] -> Lines-prettyImportGroup columns align longest imps =-    map (prettyImport columns 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 :: Int -> Align -> Step-step columns = makeStep "Imports" . step' columns------------------------------------------------------------------------------------step' :: Int -> Align -> Lines -> Module -> Lines-step' columns align ls (module', _) = flip applyChanges ls-    [ change block (const $ prettyImportGroup columns 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 
@@ -1,119 +0,0 @@----------------------------------------------------------------------------------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)------------------------------------------------------------------------------------verticalPragmas :: [String] -> Lines-verticalPragmas pragmas' =-    [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}"-    | pragma <- pragmas'-    ]-  where-    longest = maximum $ map length pragmas'------------------------------------------------------------------------------------compactPragmas :: Int -> [String] -> Lines-compactPragmas columns pragmas' = wrap columns "{-# LANGUAGE" 13 $-    map (++ ",") (init pragmas') ++ [last pragmas', "#-}"]------------------------------------------------------------------------------------prettyPragmas :: Int -> Style -> [String] -> Lines-prettyPragmas _       Vertical = verticalPragmas-prettyPragmas columns Compact  = compactPragmas columns------------------------------------------------------------------------------------step :: Int -> Style -> Bool -> Step-step columns style = makeStep "LanguagePragmas" . step' columns style------------------------------------------------------------------------------------step' :: Int -> Style -> Bool -> Lines -> Module -> Lines-step' columns 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 columns 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/Records.hs 
@@ -1,71 +0,0 @@----------------------------------------------------------------------------------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
− src/StylishHaskell/Step/Tabs.hs 
@@ -1,21 +0,0 @@----------------------------------------------------------------------------------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 
@@ -1,22 +0,0 @@----------------------------------------------------------------------------------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 
@@ -1,115 +0,0 @@----------------------------------------------------------------------------------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)])] -> [Change String]-replaceAll = map changeLine'-  where-    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-            ]------------------------------------------------------------------------------------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-    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-    perLine = sort $ groupPerLine $-        typeSigs module' ls ++-        contexts module' ls ++-        typeFuns module' ls
− src/StylishHaskell/Util.hs 
@@ -1,92 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Util-    ( nameToString-    , indent-    , padRight-    , everything-    , infoPoints-    , wrap--    , withHead-    , withLast-    , withInit-    ) 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------------------------------------------------------------------------------------import           StylishHaskell.Step------------------------------------------------------------------------------------nameToString :: H.Name l -> String-nameToString (H.Ident _ str)  = str-nameToString (H.Symbol _ str) = str------------------------------------------------------------------------------------indent :: Int -> String -> String-indent len str = replicate len ' ' ++ str------------------------------------------------------------------------------------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 ind 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], indent ind str, ind + len)-        | otherwise         = (ls, curr ++ " " ++ str, width')-      where-        len    = length str-        width' = width + 1 + len------------------------------------------------------------------------------------withHead :: (a -> a) -> [a] -> [a]-withHead _ []       = []-withHead f (x : xs) = f x : xs------------------------------------------------------------------------------------withLast :: (a -> a) -> [a] -> [a]-withLast _ []       = []-withLast f (x : []) = [f x]-withLast f (x : xs) = x : withLast f xs------------------------------------------------------------------------------------withInit :: (a -> a) -> [a] -> [a]-withInit _ []       = []-withInit _ (x : []) = [x]-withInit f (x : xs) = f x : withInit f xs
− src/StylishHaskell/Verbose.hs 
@@ -1,20 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Verbose-    ( Verbose-    , makeVerbose-    ) where------------------------------------------------------------------------------------import           System.IO (hPutStrLn, stderr)------------------------------------------------------------------------------------type Verbose = String -> IO ()------------------------------------------------------------------------------------makeVerbose :: Bool -> Verbose-makeVerbose verbose-    | verbose   = hPutStrLn stderr-    | otherwise = const $ return ()
stylish-haskell.cabal view
@@ -1,5 +1,5 @@ Name:          stylish-haskell-Version:       0.4.0.0+Version:       0.5.0.0 Synopsis:      Haskell code prettifier Homepage:      https://github.com/jaspervdj/stylish-haskell License:       BSD3@@ -19,41 +19,58 @@     <https://github.com/jaspervdj/stylish-haskell/blob/master/README.markdown>  Data-files:-  .stylish-haskell.yaml+  data/stylish-haskell.yaml -Executable stylish-haskell-  Ghc-options:    -Wall+Library+  Exposed-modules: Language.Haskell.Stylish   Hs-source-dirs: src-  Main-is:        Main.hs+  Ghc-options:    -Wall    Other-modules:-    Paths_stylish_haskell-    StylishHaskell-    StylishHaskell.Block-    StylishHaskell.Config-    StylishHaskell.Editor-    StylishHaskell.Parse-    StylishHaskell.Step-    StylishHaskell.Step.Imports-    StylishHaskell.Step.LanguagePragmas-    StylishHaskell.Step.Records-    StylishHaskell.Step.Tabs-    StylishHaskell.Step.TrailingWhitespace-    StylishHaskell.Step.UnicodeSyntax-    StylishHaskell.Util-    StylishHaskell.Verbose+    Language.Haskell.Stylish.Block+    Language.Haskell.Stylish.Config+    Language.Haskell.Stylish.Editor+    Language.Haskell.Stylish.Parse+    Language.Haskell.Stylish.Step+    Language.Haskell.Stylish.Step.Imports+    Language.Haskell.Stylish.Step.LanguagePragmas+    Language.Haskell.Stylish.Step.Records+    Language.Haskell.Stylish.Step.Tabs+    Language.Haskell.Stylish.Step.TrailingWhitespace+    Language.Haskell.Stylish.Step.UnicodeSyntax+    Language.Haskell.Stylish.Util+    Language.Haskell.Stylish.Verbose    Build-depends:     aeson            >= 0.6  && < 0.7,     base             >= 4    && < 5,     bytestring       >= 0.9  && < 0.10,-    cmdargs          >= 0.9  && < 0.11,     containers       >= 0.3  && < 0.6,     directory        >= 1.1  && < 1.2,     filepath         >= 1.1  && < 1.4,     haskell-src-exts >= 1.13 && < 1.14,     mtl              >= 2.0  && < 2.2,+    syb              >= 0.3  && < 0.4,+    yaml             >= 0.7  && < 0.9++Executable stylish-haskell+  Ghc-options:    -Wall+  Hs-source-dirs: src+  Main-is:        Main.hs++  Build-depends:+    stylish-haskell,     strict           >= 0.3  && < 0.4,+    cmdargs          >= 0.9  && < 0.11,+    -- Copied from regular dependencies...+    aeson            >= 0.6  && < 0.7,+    base             >= 4    && < 5,+    bytestring       >= 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,+    mtl              >= 2.0  && < 2.2,     syb              >= 0.3  && < 0.4,     yaml             >= 0.7  && < 0.9 @@ -64,14 +81,14 @@   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-    StylishHaskell.Tests.Util+    Language.Haskell.Stylish.Parse.Tests+    Language.Haskell.Stylish.Step.Imports.Tests+    Language.Haskell.Stylish.Step.LanguagePragmas.Tests+    Language.Haskell.Stylish.Step.Records.Tests+    Language.Haskell.Stylish.Step.Tabs.Tests+    Language.Haskell.Stylish.Step.TrailingWhitespace.Tests+    Language.Haskell.Stylish.Step.UnicodeSyntax.Tests+    Language.Haskell.Stylish.Tests.Util    Build-depends:     HUnit                >= 1.2 && < 1.3,@@ -87,7 +104,6 @@     filepath         >= 1.1  && < 1.4,     haskell-src-exts >= 1.13 && < 1.14,     mtl              >= 2.0  && < 2.2,-    strict           >= 0.3  && < 0.4,     syb              >= 0.3  && < 0.4,     yaml             >= 0.7  && < 0.9
+ tests/Language/Haskell/Stylish/Parse/Tests.hs view
@@ -0,0 +1,44 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Parse.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     (Assertion, assert)+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Parse+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Language.Haskell.Stylish.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
+ tests/Language/Haskell/Stylish/Step/Imports/Tests.hs view
@@ -0,0 +1,110 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.Imports.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     (Assertion, (@=?))+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Step.Imports+import           Language.Haskell.Stylish.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests"+    [ testCase "case 01" case01+    , testCase "case 02" case02+    , testCase "case 03" case03+    , testCase "case 04" case04+    ]+++--------------------------------------------------------------------------------+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)"+    , "import  Foo (Bar (..))"+    , ""+    , "herp = putStrLn \"import Hello world\""+    ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = expected @=? testStep (step 80 Global) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import           Control.Monad"+        , "import           Data.Map            (Map, insert, lookup, (!))"+        , "import qualified Data.Map            as M"+        , ""+        , "import           Foo                 (Bar (..))"+        , "import           Herp.Derp.Internals hiding (foo)"+        , ""+        , "herp = putStrLn \"import Hello world\""+        ]+++--------------------------------------------------------------------------------+case02 :: Assertion+case02 = expected @=? testStep (step 80 Group) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import           Control.Monad"+        , "import           Data.Map      (Map, insert, lookup, (!))"+        , "import qualified Data.Map      as M"+        , ""+        , "import Foo                 (Bar (..))"+        , "import Herp.Derp.Internals hiding (foo)"+        , ""+        , "herp = putStrLn \"import Hello world\""+        ]+++--------------------------------------------------------------------------------+case03 :: Assertion+case03 = expected @=? testStep (step 80 None) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import Control.Monad"+        , "import Data.Map (Map, insert, lookup, (!))"+        , "import qualified Data.Map as M"+        , ""+        , "import Foo (Bar (..))"+        , "import Herp.Derp.Internals hiding (foo)"+        , ""+        , "herp = putStrLn \"import Hello world\""+        ]+++--------------------------------------------------------------------------------+case04 :: Assertion+case04 = expected @=? testStep (step 80 Global) input'+  where+    input' =+        "import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," +++        "ToJSON(..), Value(..), parseEither, (.!=), (.:), (.:?), (.=))"++    expected = unlines+        [ "import           Data.Aeson.Types (FromJSON (..), ToJSON (..), Value (..),"+        , "                                   object, parseEither, typeMismatch, (.!=),"+        , "                                   (.:), (.:?), (.=))"+        ]
+ tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs view
@@ -0,0 +1,93 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.LanguagePragmas.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                      (Test, testGroup)+import           Test.Framework.Providers.HUnit      (testCase)+import           Test.HUnit                          (Assertion, (@=?))+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Step.LanguagePragmas+import           Language.Haskell.Stylish.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Language.Haskell.Stylish.Step.LanguagePragmas.Tests"+    [ testCase "case 01" case01+    , testCase "case 02" case02+    , testCase "case 03" case03+    , testCase "case 04" case04+    ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = expected @=? testStep (step 80 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 :: Assertion+case02 = expected @=? testStep (step 80 Vertical True) input+  where+    input = unlines+        [ "{-# LANGUAGE BangPatterns #-}"+        , "{-# LANGUAGE ViewPatterns #-}"+        , "increment ((+ 1) -> x) = x"+        ]++    expected = unlines+        [ "{-# LANGUAGE ViewPatterns #-}"+        , "increment ((+ 1) -> x) = x"+        ]+++--------------------------------------------------------------------------------+case03 :: Assertion+case03 = expected @=? testStep (step 80 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 :: Assertion+case04 = expected @=? testStep (step 80 Compact False) input+  where+    input = unlines+        [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"+        , "    TemplateHaskell #-}"+        , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"+        ]++    expected = unlines+        [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " +++            "TemplateHaskell,"+        , "             TypeOperators, ViewPatterns #-}"+        ]
+ tests/Language/Haskell/Stylish/Step/Records/Tests.hs view
@@ -0,0 +1,41 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.Records.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     (Assertion, (@=?))+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Step.Records+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 input+  where+    input = unlines+        [ "data Foo = Foo"+        , "    { foo :: Int"+        , "    , barqux :: String"+        , "    } deriving (Show)"+        ]++    expected = unlines+        [ "data Foo = Foo"+        , "    { foo    :: Int"+        , "    , barqux :: String"+        , "    } deriving (Show)"+        ]
+ tests/Language/Haskell/Stylish/Step/Tabs/Tests.hs view
@@ -0,0 +1,43 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.Tabs.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                 (Test, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit                     (Assertion, (@=?))+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Step.Tabs+import           Language.Haskell.Stylish.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Language.Haskell.Stylish.Step.Tabs.Tests"+    [ testCase "case 01" case01+    ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = 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/Language/Haskell/Stylish/Step/TrailingWhitespace/Tests.hs view
@@ -0,0 +1,39 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.TrailingWhitespace.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                         (Test, testGroup)+import           Test.Framework.Providers.HUnit         (testCase)+import           Test.HUnit                             (Assertion, (@=?))+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Step.TrailingWhitespace+import           Language.Haskell.Stylish.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Language.Haskell.Stylish.Step.TrailingWhitespace.Tests"+    [ testCase "case 01" case01+    ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = 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/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs view
@@ -0,0 +1,38 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.UnicodeSyntax.Tests+    ( tests+    ) where+++--------------------------------------------------------------------------------+import           Test.Framework                    (Test, testGroup)+import           Test.Framework.Providers.HUnit    (testCase)+import           Test.HUnit                        (Assertion, (@=?))+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Step.UnicodeSyntax+import           Language.Haskell.Stylish.Tests.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Language.Haskell.Stylish.Step.UnicodeSyntax.Tests"+    [ testCase "case 01" case01+    ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = 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/Language/Haskell/Stylish/Tests/Util.hs view
@@ -0,0 +1,17 @@+module Language.Haskell.Stylish.Tests.Util+    ( testStep+    ) where+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Parse+import           Language.Haskell.Stylish.Step+++--------------------------------------------------------------------------------+testStep :: Step -> String -> String+testStep step str = case parseModule [] Nothing str of+    Left err      -> error err+    Right module' -> unlines $ stepFilter step ls module'+  where+    ls = lines str
− tests/StylishHaskell/Parse/Tests.hs 
@@ -1,44 +0,0 @@----------------------------------------------------------------------------------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
− tests/StylishHaskell/Step/Imports/Tests.hs 
@@ -1,110 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Step.Imports.Tests-    ( tests-    ) where------------------------------------------------------------------------------------import           Test.Framework                 (Test, testGroup)-import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     (Assertion, (@=?))------------------------------------------------------------------------------------import           StylishHaskell.Step.Imports-import           StylishHaskell.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "StylishHaskell.Step.Imports.Tests"-    [ testCase "case 01" case01-    , testCase "case 02" case02-    , testCase "case 03" case03-    , testCase "case 04" case04-    ]------------------------------------------------------------------------------------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)"-    , "import  Foo (Bar (..))"-    , ""-    , "herp = putStrLn \"import Hello world\""-    ]------------------------------------------------------------------------------------case01 :: Assertion-case01 = expected @=? testStep (step 80 Global) input-  where-    expected = unlines-        [ "module Herp where"-        , ""-        , "import           Control.Monad"-        , "import           Data.Map            (Map, insert, lookup, (!))"-        , "import qualified Data.Map            as M"-        , ""-        , "import           Foo                 (Bar (..))"-        , "import           Herp.Derp.Internals hiding (foo)"-        , ""-        , "herp = putStrLn \"import Hello world\""-        ]------------------------------------------------------------------------------------case02 :: Assertion-case02 = expected @=? testStep (step 80 Group) input-  where-    expected = unlines-        [ "module Herp where"-        , ""-        , "import           Control.Monad"-        , "import           Data.Map      (Map, insert, lookup, (!))"-        , "import qualified Data.Map      as M"-        , ""-        , "import Foo                 (Bar (..))"-        , "import Herp.Derp.Internals hiding (foo)"-        , ""-        , "herp = putStrLn \"import Hello world\""-        ]------------------------------------------------------------------------------------case03 :: Assertion-case03 = expected @=? testStep (step 80 None) input-  where-    expected = unlines-        [ "module Herp where"-        , ""-        , "import Control.Monad"-        , "import Data.Map (Map, insert, lookup, (!))"-        , "import qualified Data.Map as M"-        , ""-        , "import Foo (Bar (..))"-        , "import Herp.Derp.Internals hiding (foo)"-        , ""-        , "herp = putStrLn \"import Hello world\""-        ]------------------------------------------------------------------------------------case04 :: Assertion-case04 = expected @=? testStep (step 80 Global) input'-  where-    input' =-        "import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," ++-        "ToJSON(..), Value(..), parseEither, (.!=), (.:), (.:?), (.=))"--    expected = unlines-        [ "import           Data.Aeson.Types (FromJSON (..), ToJSON (..), Value (..),"-        , "                                   object, parseEither, typeMismatch, (.!=),"-        , "                                   (.:), (.:?), (.=))"-        ]
− tests/StylishHaskell/Step/LanguagePragmas/Tests.hs 
@@ -1,93 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Step.LanguagePragmas.Tests-    ( tests-    ) where------------------------------------------------------------------------------------import           Test.Framework                      (Test, testGroup)-import           Test.Framework.Providers.HUnit      (testCase)-import           Test.HUnit                          (Assertion, (@=?))------------------------------------------------------------------------------------import           StylishHaskell.Step.LanguagePragmas-import           StylishHaskell.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "StylishHaskell.Step.LanguagePragmas.Tests"-    [ testCase "case 01" case01-    , testCase "case 02" case02-    , testCase "case 03" case03-    , testCase "case 04" case04-    ]------------------------------------------------------------------------------------case01 :: Assertion-case01 = expected @=? testStep (step 80 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 :: Assertion-case02 = expected @=? testStep (step 80 Vertical True) input-  where-    input = unlines-        [ "{-# LANGUAGE BangPatterns #-}"-        , "{-# LANGUAGE ViewPatterns #-}"-        , "increment ((+ 1) -> x) = x"-        ]--    expected = unlines-        [ "{-# LANGUAGE ViewPatterns #-}"-        , "increment ((+ 1) -> x) = x"-        ]------------------------------------------------------------------------------------case03 :: Assertion-case03 = expected @=? testStep (step 80 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 :: Assertion-case04 = expected @=? testStep (step 80 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/Records/Tests.hs 
@@ -1,41 +0,0 @@----------------------------------------------------------------------------------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)"-        ]
− tests/StylishHaskell/Step/Tabs/Tests.hs 
@@ -1,43 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Step.Tabs.Tests-    ( tests-    ) where------------------------------------------------------------------------------------import           Test.Framework                 (Test, testGroup)-import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     (Assertion, (@=?))------------------------------------------------------------------------------------import           StylishHaskell.Step.Tabs-import           StylishHaskell.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "StylishHaskell.Step.Tabs.Tests"-    [ testCase "case 01" case01-    ]------------------------------------------------------------------------------------case01 :: Assertion-case01 = 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 
@@ -1,39 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Step.TrailingWhitespace.Tests-    ( tests-    ) where------------------------------------------------------------------------------------import           Test.Framework                         (Test, testGroup)-import           Test.Framework.Providers.HUnit         (testCase)-import           Test.HUnit                             (Assertion, (@=?))------------------------------------------------------------------------------------import           StylishHaskell.Step.TrailingWhitespace-import           StylishHaskell.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "StylishHaskell.Step.TrailingWhitespace.Tests"-    [ testCase "case 01" case01-    ]------------------------------------------------------------------------------------case01 :: Assertion-case01 = 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 
@@ -1,38 +0,0 @@----------------------------------------------------------------------------------module StylishHaskell.Step.UnicodeSyntax.Tests-    ( tests-    ) where------------------------------------------------------------------------------------import           Test.Framework                    (Test, testGroup)-import           Test.Framework.Providers.HUnit    (testCase)-import           Test.HUnit                        (Assertion, (@=?))------------------------------------------------------------------------------------import           StylishHaskell.Step.UnicodeSyntax-import           StylishHaskell.Tests.Util------------------------------------------------------------------------------------tests :: Test-tests = testGroup "StylishHaskell.Step.UnicodeSyntax.Tests"-    [ testCase "case 01" case01-    ]------------------------------------------------------------------------------------case01 :: Assertion-case01 = 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/Tests/Util.hs 
@@ -1,17 +0,0 @@-module StylishHaskell.Tests.Util-    ( testStep-    ) where------------------------------------------------------------------------------------import           StylishHaskell.Parse-import           StylishHaskell.Step------------------------------------------------------------------------------------testStep :: Step -> String -> String-testStep step str = case parseModule [] Nothing str of-    Left err      -> error err-    Right module' -> unlines $ stepFilter step ls module'-  where-    ls = lines str
tests/TestSuite.hs view
@@ -9,23 +9,23 @@   ---------------------------------------------------------------------------------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+import qualified Language.Haskell.Stylish.Parse.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+import qualified Language.Haskell.Stylish.Step.Tabs.Tests+import qualified Language.Haskell.Stylish.Step.TrailingWhitespace.Tests+import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests   -------------------------------------------------------------------------------- main :: IO () main = defaultMain-    [ 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+    [ Language.Haskell.Stylish.Parse.Tests.tests+    , Language.Haskell.Stylish.Step.Imports.Tests.tests+    , Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests+    , Language.Haskell.Stylish.Step.Records.Tests.tests+    , Language.Haskell.Stylish.Step.Tabs.Tests.tests+    , Language.Haskell.Stylish.Step.TrailingWhitespace.Tests.tests+    , Language.Haskell.Stylish.Step.UnicodeSyntax.Tests.tests     ]