diff options
author | Jasper Van der Jeugt <m@jaspervdj.be> | 2016-02-01 11:12:59 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2016-02-01 11:12:59 +0100 |
commit | 337983bc827db048263ecc5d77eae824e3d8ca1d (patch) | |
tree | c28447d902b4234eccaa5df469cf8bffe2c26e98 /src | |
parent | 95f27fee0b5abed6052b7675b5b8bd6e77cb092d (diff) | |
download | stylish-haskell-337983bc827db048263ecc5d77eae824e3d8ca1d.tar.gz |
Fix warnings
Diffstat (limited to 'src')
-rw-r--r-- | src/Language/Haskell/Stylish.hs | 93 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Block.hs | 91 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Config.hs | 231 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Editor.hs | 101 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Parse.hs | 74 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Step.hs | 32 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Step/Imports.hs | 277 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Step/LanguagePragmas.hs | 168 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Step/Records.hs | 79 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Step/Tabs.hs | 21 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Step/TrailingWhitespace.hs | 22 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Step/UnicodeSyntax.hs | 115 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Util.hs | 128 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Verbose.hs | 20 |
14 files changed, 0 insertions, 1452 deletions
diff --git a/src/Language/Haskell/Stylish.hs b/src/Language/Haskell/Stylish.hs deleted file mode 100644 index b8620ae..0000000 --- a/src/Language/Haskell/Stylish.hs +++ /dev/null @@ -1,93 +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 -- ^ 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 diff --git a/src/Language/Haskell/Stylish/Block.hs b/src/Language/Haskell/Stylish/Block.hs deleted file mode 100644 index fd680a8..0000000 --- a/src/Language/Haskell/Stylish/Block.hs +++ /dev/null @@ -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) diff --git a/src/Language/Haskell/Stylish/Config.hs b/src/Language/Haskell/Stylish/Config.hs deleted file mode 100644 index 556002d..0000000 --- a/src/Language/Haskell/Stylish/Config.hs +++ /dev/null @@ -1,231 +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 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 diff --git a/src/Language/Haskell/Stylish/Editor.hs b/src/Language/Haskell/Stylish/Editor.hs deleted file mode 100644 index 5d5a864..0000000 --- a/src/Language/Haskell/Stylish/Editor.hs +++ /dev/null @@ -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 diff --git a/src/Language/Haskell/Stylish/Parse.hs b/src/Language/Haskell/Stylish/Parse.hs deleted file mode 100644 index f8e24a6..0000000 --- a/src/Language/Haskell/Stylish/Parse.hs +++ /dev/null @@ -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 diff --git a/src/Language/Haskell/Stylish/Step.hs b/src/Language/Haskell/Stylish/Step.hs deleted file mode 100644 index f053f8b..0000000 --- a/src/Language/Haskell/Stylish/Step.hs +++ /dev/null @@ -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 diff --git a/src/Language/Haskell/Stylish/Step/Imports.hs b/src/Language/Haskell/Stylish/Step/Imports.hs deleted file mode 100644 index 14bb818..0000000 --- a/src/Language/Haskell/Stylish/Step/Imports.hs +++ /dev/null @@ -1,277 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} --------------------------------------------------------------------------------- -module Language.Haskell.Stylish.Step.Imports - ( Align (..) - , ImportAlign (..) - , ListAlign (..) - , LongListAlign (..) - , step - ) where - - --------------------------------------------------------------------------------- - -import Control.Arrow ((&&&)) -import Data.Char (toLower) -import Data.Functor ((<$>)) -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 diff --git a/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs b/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs deleted file mode 100644 index 0239736..0000000 --- a/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs +++ /dev/null @@ -1,168 +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 -> 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]] diff --git a/src/Language/Haskell/Stylish/Step/Records.hs b/src/Language/Haskell/Stylish/Step/Records.hs deleted file mode 100644 index c8f6d19..0000000 --- a/src/Language/Haskell/Stylish/Step/Records.hs +++ /dev/null @@ -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 diff --git a/src/Language/Haskell/Stylish/Step/Tabs.hs b/src/Language/Haskell/Stylish/Step/Tabs.hs deleted file mode 100644 index 0694cd9..0000000 --- a/src/Language/Haskell/Stylish/Step/Tabs.hs +++ /dev/null @@ -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 diff --git a/src/Language/Haskell/Stylish/Step/TrailingWhitespace.hs b/src/Language/Haskell/Stylish/Step/TrailingWhitespace.hs deleted file mode 100644 index dbc594c..0000000 --- a/src/Language/Haskell/Stylish/Step/TrailingWhitespace.hs +++ /dev/null @@ -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 diff --git a/src/Language/Haskell/Stylish/Step/UnicodeSyntax.hs b/src/Language/Haskell/Stylish/Step/UnicodeSyntax.hs deleted file mode 100644 index 1e00275..0000000 --- a/src/Language/Haskell/Stylish/Step/UnicodeSyntax.hs +++ /dev/null @@ -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 diff --git a/src/Language/Haskell/Stylish/Util.hs b/src/Language/Haskell/Stylish/Util.hs deleted file mode 100644 index ed5de91..0000000 --- a/src/Language/Haskell/Stylish/Util.hs +++ /dev/null @@ -1,128 +0,0 @@ --------------------------------------------------------------------------------- -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 diff --git a/src/Language/Haskell/Stylish/Verbose.hs b/src/Language/Haskell/Stylish/Verbose.hs deleted file mode 100644 index 5519e43..0000000 --- a/src/Language/Haskell/Stylish/Verbose.hs +++ /dev/null @@ -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 () |