packages feed

stylish-haskell 0.5.14.4 → 0.5.15.0

raw patch · 33 files changed

+1877/−1297 lines, 33 filesdep ~base

Dependency ranges changed: base

Files

CHANGELOG view
@@ -1,3 +1,6 @@+- 0.5.15.0+    * Add new options for import list alignment (by Ondřej Janošík)+ - 0.5.14.4     * Bump `stylish-haskell` to 1.17.0
data/stylish-haskell.yaml view
@@ -33,6 +33,73 @@       # Default: global.       align: global +      # Folowing options affect only import list alignment.+      #+      # List align has following options:+      #+      # - after_alias: Import list is aligned with end of import including+      #   'as' and 'hiding' keywords.+      #+      #   > import qualified Data.List      as List (concat, foldl, foldr, head,+      #   >                                          init, last, length)+      #+      # - with_alias: Import list is aligned with start of alias or hiding.+      #+      #   > import qualified Data.List      as List (concat, foldl, foldr, head,+      #   >                                 init, last, length)+      #+      # - new_line: Import list starts always on new line.+      #+      #   > import qualified Data.List      as List+      #   >     (concat, foldl, foldr, head, init, last, length)+      #+      # Default: after alias+      list_align: after_alias++      # Long list align style takes effect when import is too long. This is+      # determined by 'columns' setting.+      #+      # - inline: This option will put as much specs on same line as possible.+      #+      # - new_line: Import list will start on new line.+      #+      # - new_line_multiline: Import list will start on new line when it's+      #   short enough to fit to single line. Otherwise it'll be multiline.+      #+      # - multiline: One line per import list entry.+      #   Type with contructor list acts like single import.+      #+      #   > import qualified Data.Map as M+      #   >     ( empty+      #   >     , singleton+      #   >     , ...+      #   >     , delete+      #   >     )+      #+      # Default: inline+      long_list_align: inline++      # List padding determines indentation of import list on lines after import.+      # This option affects 'list_align' and 'long_list_align'.+      list_padding: 4++      # Separate lists option affects formating of import list for type+      # or class. The only difference is single space between type and list+      # of constructors, selectors and class functions.+      #+      # - true: There is single space between Foldable type and list of it's+      #   functions.+      #+      #   > import Data.Foldable (Foldable (fold, foldl, foldMap))+      #+      # - false: There is no space between Foldable type and list of it's+      #   functions.+      #+      #   > import Data.Foldable (Foldable(fold, foldl, foldMap))+      #+      # Default: true+      separate_lists: true+   # Language pragmas   - language_pragmas:       # We can generate different styles of language pragma lists.@@ -46,6 +113,16 @@       #       # Default: vertical.       style: vertical++      # Align affects alignment of closing pragma brackets.+      #+      # - true: Brackets are aligned in same collumn.+      #+      # - false: Brackets are not aligned together. There is only one space+      #   between actual import and closing bracket.+      #+      # Default: true+      align: true        # stylish-haskell can detect redundancy of some language pragmas. If this       # is set to true, it will remove those redundant pragmas. Default: true.
+ lib/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.Monad                                    (foldM)+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Config+import           Language.Haskell.Stylish.Parse+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+import           Paths_stylish_haskell                            (version)+++--------------------------------------------------------------------------------+imports :: Int -- ^ columns+        -> Imports.Align+        -> Step+imports = Imports.step+++--------------------------------------------------------------------------------+languagePragmas :: Int -- ^ columns+                -> LanguagePragmas.Style+                -> Bool -- ^ Pad to same length in vertical mode?+                -> 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
+ lib/Language/Haskell/Stylish/Block.hs view
@@ -0,0 +1,91 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Block+    ( Block (..)+    , LineBlock+    , SpanBlock+    , blockLength+    , linesFromSrcSpan+    , spanFromSrcSpan+    , moveBlock+    , adjacent+    , merge+    , overlapping+    , groupAdjacent+    ) 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+++--------------------------------------------------------------------------------+-- | Groups adjacent blocks into larger blocks+groupAdjacent :: [(Block a, b)]+              -> [(Block a, [b])]+groupAdjacent = foldr go []+  where+    -- This code is ugly and not optimal, and no fucks were given.+    go (b1, x) gs = case break (adjacent b1 . fst) gs of+        (_, [])               -> (b1, [x]) : gs+        (ys, ((b2, xs) : zs)) -> (merge b1 b2, x : xs) : (ys ++ zs)
+ lib/Language/Haskell/Stylish/Config.hs view
@@ -0,0 +1,229 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Language.Haskell.Stylish.Config+    ( Extensions+    , Config (..)+    , defaultConfigFilePath+    , configFilePath+    , loadConfig+    ) where+++--------------------------------------------------------------------------------+import           Control.Monad                                    (forM, 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                                        (inits,+                                                                   intercalate)+import           Data.Map                                         (Map)+import qualified Data.Map                                         as M+import           Data.Yaml                                        (decodeEither)+import           System.Directory+import           System.FilePath                                  (joinPath,+                                                                   splitPath,+                                                                   (</>))+++--------------------------------------------------------------------------------+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+import           Paths_stylish_haskell                            (getDataFileName)+++--------------------------------------------------------------------------------+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 _       (Just userSpecified) = return $ Just userSpecified+configFilePath verbose Nothing              = do+    current <- getCurrentDirectory+    home    <- getHomeDirectory+    def     <- defaultConfigFilePath+    search $+        [d </> configFileName | d <- ancestors current] +++        [home </> configFileName, def]+  where+    -- All ancestors of a dir (including that dir)+    ancestors :: FilePath -> [FilePath]+    ancestors = init . map joinPath . reverse . inits . splitPath++    search :: [FilePath] -> IO (Maybe FilePath)+    search []       = return Nothing+    search (f : fs) = do+        -- TODO Maybe catch an error here, dir might be unreadable+        exists <- doesFileExist f+        verbose $ f ++ if exists then " exists" else " does not exist"+        if exists then return (Just f) else search fs+++--------------------------------------------------------------------------------+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+    stepValues <- o A..: "steps" :: A.Parser [A.Value]+    steps      <- mapM (parseSteps config) stepValues+    return config {configSteps = concat 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)+    <*> (Imports.Align+        <$> (o A..:? "align" >>= parseEnum aligns Imports.Global)+        <*> (o A..:? "list_align" >>= parseEnum listAligns Imports.AfterAlias)+        <*> (o A..:? "long_list_align"+            >>= parseEnum longListAligns Imports.Inline)+        <*> (maybe 4 (max 1) <$> o A..:? "list_padding")+            -- ^ Padding have to be at least 1. Default is 4.+        <*> o A..:? "separate_lists" A..!= True)+  where+    aligns =+        [ ("global", Imports.Global)+        , ("file",   Imports.File)+        , ("group",  Imports.Group)+        , ("none",   Imports.None)+        ]++    listAligns =+        [ ("new_line",    Imports.NewLine)+        , ("with_alias",  Imports.WithAlias)+        , ("after_alias", Imports.AfterAlias)+        ]++    longListAligns =+        [ ("inline",             Imports.Inline)+        , ("new_line",           Imports.InlineWithBreak)+        , ("new_line_multiline", Imports.InlineToMultiline)+        , ("multiline",          Imports.Multiline)+        ]+++--------------------------------------------------------------------------------+parseLanguagePragmas :: Config -> A.Object -> A.Parser Step+parseLanguagePragmas config o = LanguagePragmas.step+    <$> pure (configColumns config)+    <*> (o A..:? "style" >>= parseEnum styles LanguagePragmas.Vertical)+    <*> o A..:? "align" A..!= True+    <*> o A..:? "remove_redundant" A..!= True+  where+    styles =+        [ ("vertical",     LanguagePragmas.Vertical)+        , ("compact",      LanguagePragmas.Compact)+        , ("compact_line", LanguagePragmas.CompactLine)+        ]+++--------------------------------------------------------------------------------+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
+ lib/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
+ lib/Language/Haskell/Stylish/Parse.hs view
@@ -0,0 +1,74 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Parse+    ( parseModule+    ) where+++--------------------------------------------------------------------------------+import           Data.Maybe                      (fromMaybe, listToMaybe)+import qualified Language.Haskell.Exts.Annotated as H+import Data.List (isPrefixOf)+++--------------------------------------------------------------------------------+import           Language.Haskell.Stylish.Config+import           Language.Haskell.Stylish.Step+++--------------------------------------------------------------------------------+-- | Filter out lines which use CPP macros+unCpp :: String -> String+unCpp = unlines . go False . lines+  where+    go _           []       = []+    go isMultiline (x : xs) =+        let isCpp         = isMultiline || listToMaybe x == Just '#'+            nextMultiline = isCpp && not (null x) && last x == '\\'+        in (if isCpp then "" else x) : go nextMultiline xs+++--------------------------------------------------------------------------------+-- | Remove shebang from the first line+unShebang :: String -> String+unShebang str+    | "#!" `isPrefixOf` str = unlines $ ("" :) $ drop 1 $ lines str+    | otherwise             = str+++--------------------------------------------------------------------------------+-- | 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+++--------------------------------------------------------------------------------+-- | 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+    let noBom            = dropBom string+        extraExts'       = map H.classifyExtension extraExts+        (lang, fileExts) = fromMaybe (Nothing, []) $ H.readExtensions noBom+        exts             = fileExts ++ extraExts'++        -- Parsing options...+        fp       = fromMaybe "<unknown>" mfp+        mode     = H.defaultParseMode+            { H.extensions   = exts+            , H.fixities     = Nothing+            , H.baseLanguage = case lang of+                Nothing -> H.baseLanguage H.defaultParseMode+                Just l  -> l+            }++        -- Preprocessing+        processed = unShebang $+            if H.EnableExtension H.CPP `elem` exts then unCpp noBom else noBom++    case H.parseModuleWithComments mode processed of+        H.ParseOk md -> return md+        err          -> Left $+            "Language.Haskell.Stylish.Parse.parseModule: could not parse " +++            fp ++ ": " ++ show err
+ lib/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
+ lib/Language/Haskell/Stylish/Step/Imports.hs view
@@ -0,0 +1,275 @@+{-# LANGUAGE RecordWildCards #-}+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.Imports+    ( Align (..)+    , ImportAlign (..)+    , ListAlign (..)+    , LongListAlign (..)+    , step+    ) where+++--------------------------------------------------------------------------------+import           Control.Arrow                   ((&&&))+import           Data.Char                       (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 = Align+    { importAlign   :: ImportAlign+    , listAlign     :: ListAlign+    , longListAlign :: LongListAlign+    , listPadding   :: Int+    , separateLists :: Bool+    }+    deriving (Eq, Show)++data ImportAlign+    = Global+    | File+    | Group+    | None+    deriving (Eq, Show)++data ListAlign+    = NewLine+    | WithAlias+    | AfterAlias+    deriving (Eq, Show)++data LongListAlign+    = Inline+    | InlineWithBreak+    | InlineToMultiline+    | Multiline+    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)+++--------------------------------------------------------------------------------+-- | 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, Bool, String)+    key (H.IVar _ x)       = (1, isOperator x, nameToString x)+    key (H.IAbs _ _ x)         = (0, False, nameToString x)+    key (H.IThingAll _ x)    = (0, False, nameToString x)+    key (H.IThingWith _ x _) = (0, False, nameToString x)+++--------------------------------------------------------------------------------+-- | Sort the input spec list inside an 'H.ImportDecl'+sortImportSpecs :: H.ImportDecl l -> H.ImportDecl l+sortImportSpecs imp = imp {H.importSpecs = sort' <$> H.importSpecs imp}+  where+    sort' (H.ImportSpecList l h specs) = H.ImportSpecList l h $+        sortBy compareImportSpecs specs+++--------------------------------------------------------------------------------+-- | Order of imports in sublist is:+-- Constructors, accessors/methods, operators.+compareImportSubSpecs :: H.CName l -> H.CName l -> Ordering+compareImportSubSpecs = comparing key+  where+    key :: H.CName l -> (Int, Bool, String)+    key (H.ConName _ x) = (0, False,        nameToString x)+    key (H.VarName _ x) = (1, isOperator x, nameToString x)+++--------------------------------------------------------------------------------+-- | By default, haskell-src-exts pretty-prints+--+-- > import Foo (Bar(..))+--+-- but we want+--+-- > import Foo (Bar (..))+--+-- instead.+prettyImportSpec :: (Ord l) => Bool -> H.ImportSpec l -> String+prettyImportSpec separate = prettyImportSpec'+  where+    prettyImportSpec' (H.IThingAll  _ n)     = H.prettyPrint n ++ sep "(..)"+    prettyImportSpec' (H.IThingWith _ n cns) = H.prettyPrint n+        ++ sep "("+        ++ intercalate ", "+          (map H.prettyPrint $ sortBy compareImportSubSpecs cns)+        ++ ")"+    prettyImportSpec' x                      = H.prettyPrint x++    sep = if separate then (' ' :) else id+++--------------------------------------------------------------------------------+prettyImport :: (Ord l, Show l) =>+    Int -> Align -> Bool -> Bool -> Int -> H.ImportDecl l -> [String]+prettyImport columns Align{..} padQualified padName longest imp =+    case longListAlign of+        Inline -> inlineWrap+        InlineWithBreak -> longListWrapper inlineWrap inlineWithBreakWrap+        InlineToMultiline -> longListWrapper inlineWrap inlineToMultilineWrap+        Multiline -> longListWrapper inlineWrap multilineWrap+  where+    longListWrapper shortWrap longWrap+        | listAlign == NewLine+        || length shortWrap > 1+        || length (head shortWrap) > columns+            = longWrap+        | otherwise = shortWrap++    inlineWrap = inlineWrapper+        $ mapSpecs+        $ withInit (++ ",")+        . withHead ("(" ++)+        . withLast (++ ")")++    inlineWrapper = case listAlign of+        NewLine    -> (paddedNoSpecBase :) . wrapRest columns listPadding+        WithAlias  -> wrap columns paddedBase (inlineBaseLength + 1)+        -- Add 1 extra space to ensure same padding as in original code.+        AfterAlias -> withTail (' ' :)+            . wrap columns paddedBase (afterAliasBaseLength + 1)++    inlineWithBreakWrap = paddedNoSpecBase : wrapRest columns listPadding+        ( mapSpecs+        $ withInit (++ ",")+        . withHead ("(" ++)+        . withLast (++ ")"))++    inlineToMultilineWrap+        | length inlineWithBreakWrap > 2+        || any ((> columns) . length) (tail inlineWithBreakWrap)+            = multilineWrap+        | otherwise = inlineWithBreakWrap++    -- 'wrapRest 0' ensures that every item of spec list is on new line.+    multilineWrap = paddedNoSpecBase : wrapRest 0 listPadding+        ( mapSpecs+          ( withHead ("( " ++)+          . withTail (", " ++))+        ++ [")"])++    paddedBase = base $ padImport $ importName imp++    paddedNoSpecBase = base $ padImportNoSpec $ importName imp++    padImport = if hasExtras && padName+        then padRight longest+        else id++    padImportNoSpec = if (isJust (H.importAs imp) || hasHiding) && padName+        then padRight longest+        else id++    base' baseName importAs hasHiding' = unwords $ concat $ filter (not . null)+        [ ["import"]+        , qualified+        , show <$> maybeToList (H.importPkg imp)+        , [baseName]+        , importAs+        , hasHiding'+        ]++    base baseName = base' baseName+        ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp]+        ["hiding" | hasHiding]++    inlineBaseLength = length $ base' (padImport $ importName imp) [] []++    afterAliasBaseLength = length $ base' (padImport $ importName imp)+        ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp] []++    (hasHiding, importSpecs) = case H.importSpecs imp of+        Just (H.ImportSpecList _ h l) -> (h, Just l)+        _                             -> (False, Nothing)++    hasExtras = isJust (H.importAs imp) || isJust (H.importSpecs imp)++    qualified+        | H.importQualified imp = ["qualified"]+        | padQualified          = ["         "]+        | otherwise             = []++    mapSpecs f = case importSpecs of+        Nothing -> []     -- Import everything+        Just [] -> ["()"] -- Instance only imports+        Just is -> f $ map (prettyImportSpec separateLists) is+++--------------------------------------------------------------------------------+prettyImportGroup :: Int -> Align -> Bool -> Int+                  -> [H.ImportDecl LineBlock]+                  -> Lines+prettyImportGroup columns align fileAlign longest imps =+    concatMap (prettyImport columns align padQual padName longest') $+    sortBy compareImports imps+  where+    align' = importAlign align++    longest' = case align' of+        Group -> longestImport imps+        _     -> longest++    padName = align' /= None++    padQual = case align' of+        Global -> True+        File   -> fileAlign+        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', _) = applyChanges+    [ change block $ const $+        prettyImportGroup columns align fileAlign longest importGroup+    | (block, importGroup) <- groups+    ]+    ls+  where+    imps    = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module'+    longest = longestImport imps+    groups  = groupAdjacent [(H.ann i, i) | i <- imps]++    fileAlign = case importAlign align of+        File -> any H.importQualified imps+        _    -> False
+ lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs view
@@ -0,0 +1,168 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Step.LanguagePragmas+    ( Style (..)+    , step++      -- * Utilities+    , addLanguagePragma+    ) where+++--------------------------------------------------------------------------------+import qualified Data.Set                        as S+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+    | CompactLine+    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 :: Int -> Bool -> [String] -> Lines+verticalPragmas longest align pragmas' =+    [ "{-# LANGUAGE " ++ pad pragma ++ " #-}"+    | pragma <- pragmas'+    ]+  where+    pad+      | align = padRight longest+      | otherwise = id+++--------------------------------------------------------------------------------+compactPragmas :: Int -> [String] -> Lines+compactPragmas columns pragmas' = wrap columns "{-# LANGUAGE" 13 $+    map (++ ",") (init pragmas') ++ [last pragmas', "#-}"]+++--------------------------------------------------------------------------------+compactLinePragmas :: Int -> Bool -> [String] -> Lines+compactLinePragmas _ _ [] = []+compactLinePragmas columns align pragmas' = map (wrapLanguage . pad) prags+  where+    wrapLanguage ps = "{-# LANGUAGE" ++ ps ++  " #-}"++    maxWidth = columns - 16++    longest  = maximum $ map length prags++    pad+      | align = padRight longest+      | otherwise = id++    prags = map truncateComma $ wrap maxWidth "" 1 $+      map (++ ",") (init pragmas') ++ [last pragmas']+++--------------------------------------------------------------------------------+truncateComma :: String -> String+truncateComma ""     = ""+truncateComma xs+    | last xs == ',' = init xs+    | otherwise      = xs+++--------------------------------------------------------------------------------+prettyPragmas :: Int -> Int -> Bool -> Style -> [String] -> Lines+prettyPragmas _    longest align Vertical    = verticalPragmas longest align+prettyPragmas cols _       _     Compact     = compactPragmas cols+prettyPragmas cols _       align CompactLine = compactLinePragmas cols align+++--------------------------------------------------------------------------------+-- | Filter redundant (and duplicate) pragmas out of the groups. As a side+-- effect, we also sort the pragmas in their group...+filterRedundant :: (String -> Bool)+                -> [(l, [String])]+                -> [(l, [String])]+filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, [])+  where+    filterRedundant' (l, xs) (known, zs)+        | S.null xs' = (known', zs)+        | otherwise  = (known', (l, S.toAscList xs') : zs)+      where+        fxs    = filter (not . isRedundant') xs+        xs'    = S.fromList fxs `S.difference` known+        known' = xs' `S.union` known++--------------------------------------------------------------------------------+step :: Int -> Style -> Bool -> Bool -> Step+step = (((makeStep "LanguagePragmas" .) .) .) . step'+++--------------------------------------------------------------------------------+step' :: Int -> Style -> Bool -> Bool -> Lines -> Module -> Lines+step' columns style align removeRedundant ls (module', _)+    | null pragmas' = ls+    | otherwise     = applyChanges changes ls+  where+    isRedundant'+        | removeRedundant = isRedundant module'+        | otherwise       = const False++    pragmas' = pragmas $ fmap linesFromSrcSpan module'+    longest  = maximum $ map length $ snd =<< pragmas'+    groups   = [(b, concat pgs) | (b, pgs) <- groupAdjacent pragmas']+    changes  =+        [ change b (const $ prettyPragmas columns longest align style pg)+        | (b, pg) <- filterRedundant isRedundant' groups+        ]+++--------------------------------------------------------------------------------+-- | 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]]
+ lib/Language/Haskell/Stylish/Step/Records.hs view
@@ -0,0 +1,79 @@+--------------------------------------------------------------------------------+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 -> [[Alignable l]]+records modu =+    [ map fieldDeclToAlignable fields+    | H.Module _ _ _ _ decls                     <- [modu]+    , H.DataDecl _ _ _ _ cons _                  <- decls+    , H.QualConDecl _ _ _ (H.RecDecl _ _ fields) <- cons+    ]+++--------------------------------------------------------------------------------+data Alignable a = Alignable+    { aContainer :: !a+    , aLeft      :: !a+    , aRight     :: !a+    } deriving (Show)+++--------------------------------------------------------------------------------+fieldDeclToAlignable :: H.FieldDecl a -> Alignable a+fieldDeclToAlignable (H.FieldDecl ann names ty) = Alignable+    { aContainer = ann+    , aLeft      = H.ann (last names)+    , aRight     = H.ann ty+    }+++--------------------------------------------------------------------------------+-- | Align the type of a field+align :: [Alignable H.SrcSpan] -> [Change String]+align alignment = map align' alignment+  where+    longest = maximum $ map (H.srcSpanEndColumn . aLeft) alignment++    align' a = changeLine (H.srcSpanStartLine $ aContainer a) $ \str ->+        let column      = H.srcSpanEndColumn $ aLeft a+            (pre, post) = splitAt column str+        in [padRight longest (trimRight pre) ++ trimLeft post]++    trimLeft  = dropWhile isSpace+    trimRight = reverse . trimLeft . reverse+++--------------------------------------------------------------------------------+-- | Checks that all no field of the record appears on more than one line,+-- amonst other things+fixable :: [Alignable H.SrcSpan] -> Bool+fixable []     = False+fixable fields = all singleLine containers && nonOverlapping containers+  where+    containers        = map aContainer 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) ls
+ lib/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
+ lib/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
+ lib/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
+ lib/Language/Haskell/Stylish/Util.hs view
@@ -0,0 +1,128 @@+--------------------------------------------------------------------------------+module Language.Haskell.Stylish.Util+    ( nameToString+    , isOperator+    , indent+    , padRight+    , everything+    , infoPoints+    , wrap+    , wrapRest++    , withHead+    , withInit+    , withTail+    , withLast+    ) where+++--------------------------------------------------------------------------------+import           Control.Arrow                   ((&&&), (>>>))+import           Data.Char                       (isAlpha)+import           Data.Data                       (Data)+import qualified Data.Generics                   as G+import           Data.Maybe                      (fromMaybe, listToMaybe, 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+++--------------------------------------------------------------------------------+isOperator :: H.Name l -> Bool+isOperator = fromMaybe False+    . (fmap (not . isAlpha) . listToMaybe)+    . nameToString++--------------------------------------------------------------------------------+indent :: Int -> String -> String+indent len = (indentPrefix len ++)+++--------------------------------------------------------------------------------+indentPrefix :: Int -> String+indentPrefix = (`replicate` ' ')+++--------------------------------------------------------------------------------+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 = wrap' leading+  where+    wrap' ss [] = [ss]+    wrap' ss (str:strs)+        | overflows ss str =+            ss : wrapRest maxWidth ind (str:strs)+        | otherwise = wrap' (ss ++ " " ++ str) strs++    overflows ss str = length ss > maxWidth ||+        ((length ss + length str) >= maxWidth && ind + length str  <= maxWidth)+++--------------------------------------------------------------------------------+wrapRest :: Int+         -> Int+         -> [String]+         -> Lines+wrapRest maxWidth ind = reverse . wrapRest' [] ""+  where+    wrapRest' ls ss []+        | null ss = ls+        | otherwise = ss:ls+    wrapRest' ls ss (str:strs)+        | null ss = wrapRest' ls (indent ind str) strs+        | overflows ss str = wrapRest' (ss:ls) "" (str:strs)+        | otherwise = wrapRest' ls (ss ++ " " ++ str) strs++    overflows ss str = (length ss + length str + 1) >= maxWidth+++--------------------------------------------------------------------------------+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++--------------------------------------------------------------------------------+withTail :: (a -> a) -> [a] -> [a]+withTail _ [] = []+withTail f (x : xs) = x : map f xs
+ lib/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/Language/Haskell/Stylish.hs 
@@ -1,92 +0,0 @@----------------------------------------------------------------------------------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 
@@ -1,91 +0,0 @@----------------------------------------------------------------------------------module Language.Haskell.Stylish.Block-    ( Block (..)-    , LineBlock-    , SpanBlock-    , blockLength-    , linesFromSrcSpan-    , spanFromSrcSpan-    , moveBlock-    , adjacent-    , merge-    , overlapping-    , groupAdjacent-    ) 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-------------------------------------------------------------------------------------- | Groups adjacent blocks into larger blocks-groupAdjacent :: [(Block a, b)]-              -> [(Block a, [b])]-groupAdjacent = foldr go []-  where-    -- This code is ugly and not optimal, and no fucks were given.-    go (b1, x) gs = case break (adjacent b1 . fst) gs of-        (_, [])               -> (b1, [x]) : gs-        (ys, ((b2, xs) : zs)) -> (merge b1 b2, x : xs) : (ys ++ zs)
− src/Language/Haskell/Stylish/Config.hs 
@@ -1,206 +0,0 @@----------------------------------------------------------------------------------{-# LANGUAGE OverloadedStrings #-}-module Language.Haskell.Stylish.Config-    ( Extensions-    , Config (..)-    , defaultConfigFilePath-    , configFilePath-    , loadConfig-    ) where------------------------------------------------------------------------------------import           Control.Applicative                    (pure, (<$>), (<*>))-import           Control.Monad                          (forM, 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                              (inits, intercalate)-import           Data.Map                               (Map)-import qualified Data.Map                               as M-import           Data.Yaml                              (decodeEither)-import           System.Directory-import           System.FilePath                        (joinPath, splitPath,-                                                         (</>))------------------------------------------------------------------------------------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 _       (Just userSpecified) = return $ Just userSpecified-configFilePath verbose Nothing              = do-    current <- getCurrentDirectory-    home    <- getHomeDirectory-    def     <- defaultConfigFilePath-    search $-        [d </> configFileName | d <- ancestors current] ++-        [home </> configFileName, def]-  where-    -- All ancestors of a dir (including that dir)-    ancestors :: FilePath -> [FilePath]-    ancestors = init . map joinPath . reverse . inits . splitPath--    search :: [FilePath] -> IO (Maybe FilePath)-    search []       = return Nothing-    search (f : fs) = do-        -- TODO Maybe catch an error here, dir might be unreadable-        exists <- doesFileExist f-        verbose $ f ++ if exists then " exists" else " does not exist"-        if exists then return (Just f) else search fs------------------------------------------------------------------------------------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-    stepValues <- o A..: "steps" :: A.Parser [A.Value]-    steps      <- mapM (parseSteps config) stepValues-    return config {configSteps = concat 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)-        , ("file",   Imports.File)-        , ("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)-        , ("compact_line", LanguagePragmas.CompactLine)]------------------------------------------------------------------------------------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 
@@ -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 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 
@@ -1,74 +0,0 @@----------------------------------------------------------------------------------module Language.Haskell.Stylish.Parse-    ( parseModule-    ) where------------------------------------------------------------------------------------import           Data.Maybe                      (fromMaybe, listToMaybe)-import qualified Language.Haskell.Exts.Annotated as H-import Data.List (isPrefixOf)------------------------------------------------------------------------------------import           Language.Haskell.Stylish.Config-import           Language.Haskell.Stylish.Step-------------------------------------------------------------------------------------- | Filter out lines which use CPP macros-unCpp :: String -> String-unCpp = unlines . go False . lines-  where-    go _           []       = []-    go isMultiline (x : xs) =-        let isCpp         = isMultiline || listToMaybe x == Just '#'-            nextMultiline = isCpp && not (null x) && last x == '\\'-        in (if isCpp then "" else x) : go nextMultiline xs-------------------------------------------------------------------------------------- | Remove shebang from the first line-unShebang :: String -> String-unShebang str-    | "#!" `isPrefixOf` str = unlines $ ("" :) $ drop 1 $ lines str-    | otherwise             = str-------------------------------------------------------------------------------------- | 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-------------------------------------------------------------------------------------- | 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-    let noBom            = dropBom string-        extraExts'       = map H.classifyExtension extraExts-        (lang, fileExts) = fromMaybe (Nothing, []) $ H.readExtensions noBom-        exts             = fileExts ++ extraExts'--        -- Parsing options...-        fp       = fromMaybe "<unknown>" mfp-        mode     = H.defaultParseMode-            { H.extensions   = exts-            , H.fixities     = Nothing-            , H.baseLanguage = case lang of-                Nothing -> H.baseLanguage H.defaultParseMode-                Just l  -> l-            }--        -- Preprocessing-        processed = unShebang $-            if H.EnableExtension H.CPP `elem` exts then unCpp noBom else noBom--    case H.parseModuleWithComments mode processed of-        H.ParseOk md -> return md-        err          -> Left $-            "Language.Haskell.Stylish.Parse.parseModule: could not parse " ++-            fp ++ ": " ++ show err
− src/Language/Haskell/Stylish/Step.hs 
@@ -1,32 +0,0 @@----------------------------------------------------------------------------------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 
@@ -1,172 +0,0 @@----------------------------------------------------------------------------------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-    | File-    | 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)-------------------------------------------------------------------------------------- | 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 =-    wrap columns base (length base + 2) $-    (if hiding then ("hiding" :) else id) $-    case importSpecs of-        Nothing -> []     -- Import everything-        Just [] -> ["()"] -- Instance only imports-        Just is ->-            withInit (++ ",") $-            withHead ("(" ++) $-            withLast (++ ")") $-            map prettyImportSpec $-            is-  where-    base = unwords $ concat-         [ ["import"]-         , qualified-         , (fmap show $ maybeToList $ H.importPkg imp)-         , [(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, Just l)-        _                             -> (False, Nothing)--    hasExtras = isJust (H.importAs imp) || isJust (H.importSpecs imp)--    qualified-        | H.importQualified imp = ["qualified"]-        | padQualified          = ["         "]-        | otherwise             = []------------------------------------------------------------------------------------prettyImportGroup :: Int -> Align -> Bool -> Int -> [H.ImportDecl LineBlock]-                  -> Lines-prettyImportGroup columns align fileAlign longest imps =-    concatMap (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-        File   -> fileAlign-        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 fileAlign longest importGroup-    | (block, importGroup) <- groups-    ]-  where-    imps    = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module'-    longest = longestImport imps-    groups  = groupAdjacent [(H.ann i, i) | i <- imps]--    fileAlign = case align of-        File -> any H.importQualified imps-        _    -> False
− src/Language/Haskell/Stylish/Step/LanguagePragmas.hs 
@@ -1,158 +0,0 @@----------------------------------------------------------------------------------module Language.Haskell.Stylish.Step.LanguagePragmas-    ( Style (..)-    , step--      -- * Utilities-    , addLanguagePragma-    ) where------------------------------------------------------------------------------------import qualified Data.Set                        as S-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-    | CompactLine-    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 :: Int -> [String] -> Lines-verticalPragmas longest pragmas' =-    [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}"-    | pragma <- pragmas'-    ]------------------------------------------------------------------------------------compactPragmas :: Int -> [String] -> Lines-compactPragmas columns pragmas' = wrap columns "{-# LANGUAGE" 13 $-    map (++ ",") (init pragmas') ++ [last pragmas', "#-}"]------------------------------------------------------------------------------------compactLinePragmas :: Int -> [String] -> Lines-compactLinePragmas _ [] = []-compactLinePragmas columns pragmas' =-  let maxWidth = columns - 16-      longest  = maximum $ map length prags-      prags    = map truncateComma $ wrap maxWidth "" 1 $-                    map (++ ",") (init pragmas') ++ [last pragmas']-  in map (wrapLanguage . padRight longest) prags-  where-    wrapLanguage ps = "{-# LANGUAGE" ++ ps ++  " #-}"------------------------------------------------------------------------------------truncateComma :: String -> String-truncateComma ""     = ""-truncateComma xs-    | last xs == ',' = init xs-    | otherwise      = xs------------------------------------------------------------------------------------prettyPragmas :: Int -> Int -> Style -> [String] -> Lines-prettyPragmas _       longest Vertical    = verticalPragmas longest-prettyPragmas columns _       Compact     = compactPragmas columns-prettyPragmas columns _       CompactLine = compactLinePragmas columns-------------------------------------------------------------------------------------- | Filter redundant (and duplicate) pragmas out of the groups. As a side--- effect, we also sort the pragmas in their group...-filterRedundant :: (String -> Bool)-                -> [(l, [String])]-                -> [(l, [String])]-filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, [])-  where-    filterRedundant' (l, xs) (known, zs)-        | S.null xs' = (known', zs)-        | otherwise  = (known', (l, S.toAscList xs') : zs)-      where-        fxs    = filter (not . isRedundant') xs-        xs'    = S.fromList fxs `S.difference` known-        known' = xs' `S.union` known-----------------------------------------------------------------------------------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-    isRedundant'-        | removeRedundant = isRedundant module'-        | otherwise       = const False--    pragmas' = pragmas $ fmap linesFromSrcSpan module'-    longest  = maximum $ map length $ snd =<< pragmas'-    groups   = [(b, concat pgs) | (b, pgs) <- groupAdjacent pragmas']-    changes  =-        [ change b (const $ prettyPragmas columns longest style pg)-        | (b, pg) <- filterRedundant isRedundant' groups-        ]-------------------------------------------------------------------------------------- | 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 
@@ -1,79 +0,0 @@----------------------------------------------------------------------------------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 -> [[Alignable l]]-records modu =-    [ map fieldDeclToAlignable fields-    | H.Module _ _ _ _ decls                     <- [modu]-    , H.DataDecl _ _ _ _ cons _                  <- decls-    , H.QualConDecl _ _ _ (H.RecDecl _ _ fields) <- cons-    ]------------------------------------------------------------------------------------data Alignable a = Alignable-    { aContainer :: !a-    , aLeft      :: !a-    , aRight     :: !a-    } deriving (Show)------------------------------------------------------------------------------------fieldDeclToAlignable :: H.FieldDecl a -> Alignable a-fieldDeclToAlignable (H.FieldDecl ann names ty) = Alignable-    { aContainer = ann-    , aLeft      = H.ann (last names)-    , aRight     = H.ann ty-    }-------------------------------------------------------------------------------------- | Align the type of a field-align :: [Alignable H.SrcSpan] -> [Change String]-align alignment = map align' alignment-  where-    longest = maximum $ map (H.srcSpanEndColumn . aLeft) alignment--    align' a = changeLine (H.srcSpanStartLine $ aContainer a) $ \str ->-        let column      = H.srcSpanEndColumn $ aLeft a-            (pre, post) = splitAt column str-        in [padRight longest (trimRight pre) ++ trimLeft post]--    trimLeft  = dropWhile isSpace-    trimRight = reverse . trimLeft . reverse-------------------------------------------------------------------------------------- | Checks that all no field of the record appears on more than one line,--- amonst other things-fixable :: [Alignable H.SrcSpan] -> Bool-fixable []     = False-fixable fields = all singleLine containers && nonOverlapping containers-  where-    containers        = map aContainer 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) ls
− src/Language/Haskell/Stylish/Step/Tabs.hs 
@@ -1,21 +0,0 @@----------------------------------------------------------------------------------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 
@@ -1,22 +0,0 @@----------------------------------------------------------------------------------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 
@@ -1,115 +0,0 @@----------------------------------------------------------------------------------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 
@@ -1,95 +0,0 @@----------------------------------------------------------------------------------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-        | nextLine  = (ls ++ [curr], indent ind str, ind + len)-        | otherwise = (ls, curr ++ " " ++ str, width')-      where-        -- Put it on the next line if it would make the current line too long,-        -- AND if it doesn't make the next line too long.-        nextLine = width' > maxWidth && ind + len <= maxWidth-        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 
@@ -1,20 +0,0 @@----------------------------------------------------------------------------------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 ()
stylish-haskell.cabal view
@@ -1,5 +1,5 @@ Name:          stylish-haskell-Version:       0.5.14.4+Version:       0.5.15.0 Synopsis:      Haskell code prettifier Homepage:      https://github.com/jaspervdj/stylish-haskell License:       BSD3@@ -26,7 +26,7 @@  Library   Exposed-modules: Language.Haskell.Stylish-  Hs-source-dirs: src+  Hs-source-dirs: lib   Ghc-options:    -Wall    Other-modules:@@ -47,7 +47,7 @@    Build-depends:     aeson            >= 0.6  && < 0.11,-    base             >= 4    && < 5,+    base             >= 4.8  && < 5,     bytestring       >= 0.9  && < 0.11,     containers       >= 0.3  && < 0.6,     directory        >= 1.1  && < 1.3,@@ -68,7 +68,7 @@     cmdargs          >= 0.9  && < 0.11,     -- Copied from regular dependencies...     aeson            >= 0.6  && < 0.11,-    base             >= 4    && < 5,+    base             >= 4.8  && < 5,     bytestring       >= 0.9  && < 0.11,     containers       >= 0.3  && < 0.6,     directory        >= 1.1  && < 1.3,@@ -80,7 +80,7 @@  Test-suite stylish-haskell-tests   Ghc-options:    -Wall-  Hs-source-dirs: src tests+  Hs-source-dirs: tests lib   Main-is:        TestSuite.hs   Type:           exitcode-stdio-1.0 @@ -100,7 +100,7 @@     test-framework-hunit >= 0.2 && < 0.4,     -- Copied from regular dependencies...     aeson            >= 0.6  && < 0.11,-    base             >= 4    && < 5,+    base             >= 4.8  && < 5,     bytestring       >= 0.9  && < 0.11,     cmdargs          >= 0.9  && < 0.11,     containers       >= 0.3  && < 0.6,
tests/Language/Haskell/Stylish/Step/Imports/Tests.hs view
@@ -16,6 +16,15 @@   --------------------------------------------------------------------------------+defaultAlign :: Align+defaultAlign = Align Global AfterAlias Inline 4 True+++--------------------------------------------------------------------------------+fromImportAlign :: ImportAlign -> Align+fromImportAlign align = defaultAlign { importAlign = align }++-------------------------------------------------------------------------------- tests :: Test tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests"     [ testCase "case 01" case01@@ -25,6 +34,17 @@     , testCase "case 05" case05     , testCase "case 06" case06     , testCase "case 07" case07+    , testCase "case 08" case08+    , testCase "case 09" case09+    , testCase "case 10" case10+    , testCase "case 11" case11+    , testCase "case 12" case12+    , testCase "case 13" case13+    , testCase "case 14" case14+    , testCase "case 15" case15+    , testCase "case 16" case16+    , testCase "case 17" case17+    , testCase "case 18" case18     ]  @@ -37,6 +57,8 @@     , "import Control.Monad"     , "import  Only.Instances()"     , "import       Data.Map     (lookup, (!), insert, Map)"+    , "import Data.List as List (concat, foldl, foldr, head, init, last,\+     \ length, map, null, reverse, tail, (++))"     , ""     , "import Herp.Derp.Internals hiding (foo)"     , "import  Foo (Bar (..))"@@ -47,12 +69,15 @@  -------------------------------------------------------------------------------- case01 :: Assertion-case01 = expected @=? testStep (step 80 Global) input+case01 = expected @=? testStep (step 80 $ fromImportAlign Global) input   where     expected = unlines         [ "module Herp where"         , ""         , "import           Control.Monad"+        , "import           Data.List           as List (concat, foldl, foldr, head, init,"+        , "                                              last, length, map, null, reverse,"+        , "                                              tail, (++))"         , "import           Data.Map            (Map, insert, lookup, (!))"         , "import qualified Data.Map            as M"         , "import           Only.Instances      ()"@@ -66,12 +91,14 @@  -------------------------------------------------------------------------------- case02 :: Assertion-case02 = expected @=? testStep (step 80 Group) input+case02 = expected @=? testStep (step 80 $ fromImportAlign Group) input   where     expected = unlines         [ "module Herp where"         , ""         , "import           Control.Monad"+        , "import           Data.List      as List (concat, foldl, foldr, head, init, last,"+        , "                                         length, map, null, reverse, tail, (++))"         , "import           Data.Map       (Map, insert, lookup, (!))"         , "import qualified Data.Map       as M"         , "import           Only.Instances ()"@@ -85,12 +112,14 @@  -------------------------------------------------------------------------------- case03 :: Assertion-case03 = expected @=? testStep (step 80 None) input+case03 = expected @=? testStep (step 80 $ fromImportAlign None) input   where     expected = unlines         [ "module Herp where"         , ""         , "import Control.Monad"+        , "import Data.List as List (concat, foldl, foldr, head, init, last, length, map,"+        , "                          null, reverse, tail, (++))"         , "import Data.Map (Map, insert, lookup, (!))"         , "import qualified Data.Map as M"         , "import Only.Instances ()"@@ -104,7 +133,7 @@  -------------------------------------------------------------------------------- case04 :: Assertion-case04 = expected @=? testStep (step 80 Global) input'+case04 = expected @=? testStep (step 80 $ fromImportAlign Global) input'   where     input' =         "import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," ++@@ -119,7 +148,7 @@  -------------------------------------------------------------------------------- case05 :: Assertion-case05 = input' @=? testStep (step 80 Group) input'+case05 = input' @=? testStep (step 80 $ fromImportAlign Group) input'   where     input' = "import Distribution.PackageDescription.Configuration " ++         "(finalizePackageDescription)\n"@@ -127,7 +156,7 @@  -------------------------------------------------------------------------------- case06 :: Assertion-case06 = input' @=? testStep (step 80 File) input'+case06 = input' @=? testStep (step 80 $ fromImportAlign File) input'   where     input' = unlines         [ "import Bar.Qux"@@ -137,7 +166,7 @@  -------------------------------------------------------------------------------- case07 :: Assertion-case07 = expected @=? testStep (step 80 File) input'+case07 = expected @=? testStep (step 80 $ fromImportAlign File) input'   where     input' = unlines         [ "import Bar.Qux"@@ -149,4 +178,267 @@         [ "import           Bar.Qux"         , ""         , "import qualified Foo.Bar"+        ]+++--------------------------------------------------------------------------------+case08 :: Assertion+case08 = expected+    @=? testStep (step 80 $ Align Global WithAlias Inline 4 True) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import           Control.Monad"+        , "import           Data.List           as List (concat, foldl, foldr, head, init,"+        , "                                     last, length, map, null, reverse, tail,"+        , "                                     (++))"+        , "import           Data.Map            (Map, insert, lookup, (!))"+        , "import qualified Data.Map            as M"+        , "import           Only.Instances      ()"+        , ""+        , "import           Foo                 (Bar (..))"+        , "import           Herp.Derp.Internals hiding (foo)"+        , ""+        , "herp = putStrLn \"import Hello world\""+        ]+++--------------------------------------------------------------------------------+case09 :: Assertion+case09 = expected+    @=? testStep (step 80 $ Align Global WithAlias Multiline 4 True) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import           Control.Monad"+        , "import           Data.List           as List"+        , "    ( concat"+        , "    , foldl"+        , "    , foldr"+        , "    , head"+        , "    , init"+        , "    , last"+        , "    , length"+        , "    , map"+        , "    , null"+        , "    , reverse"+        , "    , tail"+        , "    , (++)"+        , "    )"+        , "import           Data.Map            (Map, insert, lookup, (!))"+        , "import qualified Data.Map            as M"+        , "import           Only.Instances      ()"+        , ""+        , "import           Foo                 (Bar (..))"+        , "import           Herp.Derp.Internals hiding (foo)"+        , ""+        , "herp = putStrLn \"import Hello world\""+        ]+++--------------------------------------------------------------------------------+case10 :: Assertion+case10 = expected+    @=? testStep (step 40 $ Align Group WithAlias Multiline 4 True) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import           Control.Monad"+        , "import           Data.List      as List"+        , "    ( concat"+        , "    , foldl"+        , "    , foldr"+        , "    , head"+        , "    , init"+        , "    , last"+        , "    , length"+        , "    , map"+        , "    , null"+        , "    , reverse"+        , "    , tail"+        , "    , (++)"+        , "    )"+        , "import           Data.Map"+        , "    ( Map"+        , "    , insert"+        , "    , lookup"+        , "    , (!)"+        , "    )"+        , "import qualified Data.Map       as M"+        , "import           Only.Instances ()"+        , ""+        , "import Foo                 (Bar (..))"+        , "import Herp.Derp.Internals hiding (foo)"+        , ""+        , "herp = putStrLn \"import Hello world\""+        ]+++--------------------------------------------------------------------------------+case11 :: Assertion+case11 = expected+    @=? testStep (step 80 $ Align Group NewLine Inline 4 True) input+  where+    expected = unlines+        [ "module Herp where"+        , ""+        , "import           Control.Monad"+        , "import           Data.List      as List"+        , "    (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail,"+        , "    (++))"+        , "import           Data.Map"+        , "    (Map, insert, lookup, (!))"+        , "import qualified Data.Map       as M"+        , "import           Only.Instances"+        , "    ()"+        , ""+        , "import Foo"+        , "    (Bar (..))"+        , "import Herp.Derp.Internals hiding"+        , "    (foo)"++        , ""+        , "herp = putStrLn \"import Hello world\""+        ]+++--------------------------------------------------------------------------------+case12 :: Assertion+case12 = expected+    @=? testStep (step 80 $ Align Group NewLine Inline 2 True) input'+  where+    input' = unlines+        [ "import Data.List (map)"+        ]++    expected = unlines+        [ "import Data.List"+        , "  (map)"+        ]+++--------------------------------------------------------------------------------+case13 :: Assertion+case13 = expected+    @=? testStep (step 80 $ Align None WithAlias InlineWithBreak 4 True) input'+  where+    input' = unlines+        [ "import qualified Data.List as List (concat, foldl, foldr, head, init,"+        , "    last, length, map, null, reverse, tail, (++))"+        ]++    expected = unlines+        [ "import qualified Data.List as List"+        , "    (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail,"+        , "    (++))"+        ]+++--------------------------------------------------------------------------------+case14 :: Assertion+case14 = expected+    @=? testStep+      (step 80 $ Align None WithAlias InlineWithBreak 10 True) expected+  where+    expected = unlines+        [ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))"+        ]+++--------------------------------------------------------------------------------+case15 :: Assertion+case15 = expected+    @=? testStep (step 80 $ Align None AfterAlias Multiline 4 True) input'+  where+    expected = unlines+        [ "import Data.Acid (AcidState)"+        , "import qualified Data.Acid as Acid"+        , "    ( closeAcidState"+        , "    , createCheckpoint"+        , "    , openLocalStateFrom"+        , "    )"+        , "import Data.Default.Class (Default (def))"+        , ""+        , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (bar, foo)"+        ]++    input' = unlines+        [ "import Data.Acid (AcidState)"+        , "import qualified Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)"+        , "import Data.Default.Class (Default (def))"+        , ""+        , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (foo, bar)"+        ]+++--------------------------------------------------------------------------------+case16 :: Assertion+case16 = expected+    @=? testStep (step 80 $ Align None AfterAlias Multiline 4 False) input'+  where+    expected = unlines+        [ "import Data.Acid (AcidState)"+        , "import Data.Default.Class (Default(def))"+        , ""+        , "import Data.Maybe (Maybe(Just, Nothing))"+        , ""+        , "import Data.Foo (Foo(Bar, Foo), Goo(Goo))"+        ]++    input' = unlines+        [ "import Data.Acid (AcidState)"+        , "import Data.Default.Class (Default(def))"+        , ""+        , "import Data.Maybe (Maybe   (Just, Nothing))"+        , ""+        , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))"+        ]+++--------------------------------------------------------------------------------+case17 :: Assertion+case17 = expected+    @=? testStep (step 80 $ Align None AfterAlias Multiline 4 True) input'+  where+    expected = unlines+        [ "import Control.Applicative (Applicative (pure, (<*>)))"+        , ""+        , "import Data.Identity (Identity (Identity, runIdentity))"+        ]++    input' = unlines+        [ "import Control.Applicative (Applicative ((<*>),pure))"+        , ""+        , "import Data.Identity (Identity (runIdentity,Identity))"+        ]+++--------------------------------------------------------------------------------+case18 :: Assertion+case18 = expected @=? testStep+    (step 40 $ Align None AfterAlias InlineToMultiline 4 True) input'+  where+    expected = unlines+           ----------------------------------------+        [ "import Data.Foo as Foo (Bar, Baz, Foo)"+        , ""+        , "import Data.Identity"+        , "    (Identity (Identity, runIdentity))"+        , ""+        , "import Data.Acid as Acid"+        , "    ( closeAcidState"+        , "    , createCheckpoint"+        , "    , openLocalStateFrom"+        , "    )"+        ]++    input' = unlines+        [ "import Data.Foo as Foo (Bar, Baz, Foo)"+        , ""+        , "import Data.Identity (Identity (Identity, runIdentity))"+        , ""+        , "import Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)"         ]
tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs view
@@ -24,12 +24,14 @@     , testCase "case 04" case04     , testCase "case 05" case05     , testCase "case 06" case06+    , testCase "case 07" case07+    , testCase "case 08" case08     ]   -------------------------------------------------------------------------------- case01 :: Assertion-case01 = expected @=? testStep (step 80 Vertical False) input+case01 = expected @=? testStep (step 80 Vertical True False) input   where     input = unlines         [ "{-# LANGUAGE ViewPatterns #-}"@@ -48,7 +50,7 @@  -------------------------------------------------------------------------------- case02 :: Assertion-case02 = expected @=? testStep (step 80 Vertical True) input+case02 = expected @=? testStep (step 80 Vertical True True) input   where     input = unlines         [ "{-# LANGUAGE BangPatterns #-}"@@ -64,7 +66,7 @@  -------------------------------------------------------------------------------- case03 :: Assertion-case03 = expected @=? testStep (step 80 Vertical True) input+case03 = expected @=? testStep (step 80 Vertical True True) input   where     input = unlines         [ "{-# LANGUAGE BangPatterns #-}"@@ -80,7 +82,7 @@  -------------------------------------------------------------------------------- case04 :: Assertion-case04 = expected @=? testStep (step 80 Compact False) input+case04 = expected @=? testStep (step 80 Compact True False) input   where     input = unlines         [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"@@ -97,7 +99,7 @@  -------------------------------------------------------------------------------- case05 :: Assertion-case05 = expected @=? testStep (step 80 Vertical False) input+case05 = expected @=? testStep (step 80 Vertical True False) input   where     input = unlines         [ "{-# LANGUAGE CPP #-}"@@ -115,8 +117,10 @@         , "#endif"         ] ++-------------------------------------------------------------------------------- case06 :: Assertion-case06 = expected @=? testStep (step 80 CompactLine False) input+case06 = expected @=? testStep (step 80 CompactLine True False) input   where     input = unlines         [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"@@ -127,4 +131,39 @@         [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " ++           "TemplateHaskell #-}"         , "{-# LANGUAGE TypeOperators, ViewPatterns                             #-}"+        ]++--------------------------------------------------------------------------------+case07 :: Assertion+case07 = expected @=? testStep (step 80 Vertical False False) input+  where+    input = unlines+        [ "{-# LANGUAGE ViewPatterns #-}"+        , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"+        , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"+        , "module Main where"+        ]++    expected = unlines+        [ "{-# LANGUAGE NoImplicitPrelude #-}"+        , "{-# LANGUAGE ScopedTypeVariables #-}"+        , "{-# LANGUAGE TemplateHaskell #-}"+        , "{-# LANGUAGE ViewPatterns #-}"+        , "module Main where"+        ]+++--------------------------------------------------------------------------------+case08 :: Assertion+case08 = expected @=? testStep (step 80 CompactLine False False) input+  where+    input = unlines+        [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"+        , "    TemplateHaskell #-}"+        , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"+        ]+    expected = unlines+        [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " +++          "TemplateHaskell #-}"+        , "{-# LANGUAGE TypeOperators, ViewPatterns #-}"         ]