hfmt 0.2.2 → 0.2.3.0
raw patch · 21 files changed
+1156/−1125 lines, 21 filessetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Language.Haskell.Format: Formatter :: (HaskellSource -> Either ErrorString Reformatted) -> Formatter
+ Language.Haskell.Format: Formatter :: HaskellSource -> Either ErrorString Reformatted -> Formatter
Files
- .stylish-haskell.yaml +171/−171
- LICENSE +22/−22
- README.md +59/−59
- Setup.hs +2/−2
- app/Actions.hs +41/−41
- app/ExitCode.hs +48/−48
- app/Main.hs +76/−76
- app/Options.hs +83/−83
- app/Types.hs +64/−60
- hfmt.cabal +89/−89
- src/Language/Haskell/Format.hs +49/−39
- src/Language/Haskell/Format/HIndent.hs +62/−62
- src/Language/Haskell/Format/HLint.hs +33/−33
- src/Language/Haskell/Format/Internal.hs +12/−12
- src/Language/Haskell/Format/Stylish.hs +32/−32
- src/Language/Haskell/Format/Types.hs +52/−46
- src/Language/Haskell/Format/Utilities.hs +105/−105
- src/Language/Haskell/Source/Enumerator.hs +89/−78
- src/Path/Find.hs +40/−40
- test/pure/Spec.hs +10/−10
- test/self-formatting/Spec.hs +17/−17
.stylish-haskell.yaml view
@@ -1,171 +1,171 @@-# stylish-haskell configuration file -# ================================== - -# The stylish-haskell tool is mainly configured by specifying steps. These steps -# are a list, so they have an order, and one specific step may appear more than -# once (if needed). Each file is processed by these steps in the given order. -steps: - # Convert some ASCII sequences to their Unicode equivalents. This is disabled - # by default. - # - unicode_syntax: - # # In order to make this work, we also need to insert the UnicodeSyntax - # # language pragma. If this flag is set to true, we insert it when it's - # # not already present. You may want to disable it if you configure - # # language extensions using some other method than pragmas. Default: - # # true. - # add_language_pragma: true - - # Align the right hand side of some elements. This is quite conservative - # and only applies to statements where each element occupies a single - # line. - - simple_align: - cases: true - top_level_patterns: true - records: true - - # Import cleanup - - imports: - # There are different ways we can align names and lists. - # - # - global: Align the import names and import list throughout the entire - # file. - # - # - file: Like global, but don't add padding when there are no qualified - # imports in the file. - # - # - group: Only align the imports per group (a group is formed by adjacent - # import lines). - # - # - none: Do not perform any alignment. - # - # Default: global. - align: file - - # 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. - # - # - vertical: Vertical-spaced language pragmas, one per line. - # - # - compact: A more compact style. - # - # - compact_line: Similar to compact, but wrap each line with - # `{-#LANGUAGE #-}'. - # - # 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. - remove_redundant: true - - # Replace tabs by spaces. This is disabled by default. - # - tabs: - # # Number of spaces to use for each tab. Default: 8, as specified by the - # # Haskell report. - # spaces: 2 - - # Remove trailing whitespace - - trailing_whitespace: {} - -# A common setting is the number of columns (parts of) code will be wrapped -# to. Different steps take this into account. Default: 80. -columns: 80 - -# By default, line endings are converted according to the OS. You can override -# preferred format here. -# -# - native: Native newline format. CRLF on Windows, LF on other OSes. -# -# - lf: Convert to LF ("\n"). -# -# - crlf: Convert to CRLF ("\r\n"). -# -# Default: native. -newline: native - -# Sometimes, language extensions are specified in a cabal file or from the -# command line instead of using language pragmas in the file. stylish-haskell -# needs to be aware of these, so it can parse the file correctly. -# -# No language extensions are enabled by default. -# language_extensions: - # - TemplateHaskell - # - QuasiQuotes +# stylish-haskell configuration file+# ==================================++# The stylish-haskell tool is mainly configured by specifying steps. These steps+# are a list, so they have an order, and one specific step may appear more than+# once (if needed). Each file is processed by these steps in the given order.+steps:+ # Convert some ASCII sequences to their Unicode equivalents. This is disabled+ # by default.+ # - unicode_syntax:+ # # In order to make this work, we also need to insert the UnicodeSyntax+ # # language pragma. If this flag is set to true, we insert it when it's+ # # not already present. You may want to disable it if you configure+ # # language extensions using some other method than pragmas. Default:+ # # true.+ # add_language_pragma: true++ # Align the right hand side of some elements. This is quite conservative+ # and only applies to statements where each element occupies a single+ # line.+ - simple_align:+ cases: true+ top_level_patterns: true+ records: true++ # Import cleanup+ - imports:+ # There are different ways we can align names and lists.+ #+ # - global: Align the import names and import list throughout the entire+ # file.+ #+ # - file: Like global, but don't add padding when there are no qualified+ # imports in the file.+ #+ # - group: Only align the imports per group (a group is formed by adjacent+ # import lines).+ #+ # - none: Do not perform any alignment.+ #+ # Default: global.+ align: file++ # 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.+ #+ # - vertical: Vertical-spaced language pragmas, one per line.+ #+ # - compact: A more compact style.+ #+ # - compact_line: Similar to compact, but wrap each line with+ # `{-#LANGUAGE #-}'.+ #+ # 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.+ remove_redundant: true++ # Replace tabs by spaces. This is disabled by default.+ # - tabs:+ # # Number of spaces to use for each tab. Default: 8, as specified by the+ # # Haskell report.+ # spaces: 2++ # Remove trailing whitespace+ - trailing_whitespace: {}++# A common setting is the number of columns (parts of) code will be wrapped+# to. Different steps take this into account. Default: 80.+columns: 80++# By default, line endings are converted according to the OS. You can override+# preferred format here.+#+# - native: Native newline format. CRLF on Windows, LF on other OSes.+#+# - lf: Convert to LF ("\n").+#+# - crlf: Convert to CRLF ("\r\n").+#+# Default: native.+newline: native++# Sometimes, language extensions are specified in a cabal file or from the+# command line instead of using language pragmas in the file. stylish-haskell+# needs to be aware of these, so it can parse the file correctly.+#+# No language extensions are enabled by default.+# language_extensions:+ # - TemplateHaskell+ # - QuasiQuotes
LICENSE view
@@ -1,22 +1,22 @@-The MIT License (MIT) - -Copyright (c) 2014 Daniel Stiner - -Permission is hereby granted, free of charge, to any person obtaining a copy -of this software and associated documentation files (the "Software"), to deal -in the Software without restriction, including without limitation the rights -to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -copies of the Software, and to permit persons to whom the Software is -furnished to do so, subject to the following conditions: - -The above copyright notice and this permission notice shall be included in -all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -THE SOFTWARE. - +The MIT License (MIT)++Copyright (c) 2014 Daniel Stiner++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.+
README.md view
@@ -1,59 +1,59 @@-hfmt -==== - -[](https://hackage.haskell.org/package/hfmt) -[](https://github.com/danstiner/hfmt/blob/master/LICENSE) -[](https://travis-ci.org/danstiner/hfmt) - -hfmt is a tool for formatting Haskell programs. Currently it is simply a gofmt style wrapper of the excellent tools [hlint](https://github.com/ndmitchell/hlint/blob/master/README.md), [hindent](https://github.com/chrisdone/hindent#readme), and [stylish-haskell](https://github.com/jaspervdj/stylish-haskell#readme). - - -## Installation - -with [stack](https://www.haskellstack.org/) - - $ stack install hfmt - -with [cabal](https://www.haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package) - - $ cabal install hfmt - -## Usage - -Check all Haskell source under the current directory: - - hfmt - -Overwrite files with formatting suggestions: - - hfmt -w - -## Help text - - λ hfmt --help - hfmt - format Haskell programs - - Usage: hfmt [-d|--print-diffs] [FILE] - Reformats Haskell source files by applying HLint, hindent, and - stylish-haskell. - - Available options: - -h,--help Show this help text - -d,--print-diffs If a file's formatting is different, print a diff. - -s,--print-sources If a file's formatting is different, print its - source. - -l,--print-paths If a file's formatting is different, print its path. - -w,--write-sources If a file's formatting is different, overwrite it. - FILE Explicit paths to process. - - A single '-' will process standard input. - - Files will be processed directly. - - Directories will be recursively searched for source files to process. - - .cabal files will be parsed and all specified source directories and files processed. - - If no paths are given, the current directory will be searched for .cabal files to process, if none are found the current directory will be recursively searched for source files to process. - - Exit Codes: - 0 = No error - 1 = Encountered I/O or other operational error - 2 = Failed to parse a source code file - 3 = Source code was parsed but cannot be formatted properly - 4 = Formatted code differs from existing source (--print-diffs only) +hfmt+====++[](https://hackage.haskell.org/package/hfmt)+[](https://github.com/danstiner/hfmt/blob/master/LICENSE)+[](https://travis-ci.org/danstiner/hfmt)++hfmt is a tool for formatting Haskell programs. Currently it is simply a gofmt style wrapper of the excellent tools [hlint](https://github.com/ndmitchell/hlint/blob/master/README.md), [hindent](https://github.com/chrisdone/hindent#readme), and [stylish-haskell](https://github.com/jaspervdj/stylish-haskell#readme).+++## Installation++with [stack](https://www.haskellstack.org/)++ $ stack install hfmt++with [cabal](https://www.haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package)++ $ cabal install hfmt++## Usage++Check all Haskell source under the current directory:++ hfmt++Overwrite files with formatting suggestions:++ hfmt -w++## Help text++ λ hfmt --help+ hfmt - format Haskell programs++ Usage: hfmt [-d|--print-diffs] [FILE]+ Reformats Haskell source files by applying HLint, hindent, and+ stylish-haskell.++ Available options:+ -h,--help Show this help text+ -d,--print-diffs If a file's formatting is different, print a diff.+ -s,--print-sources If a file's formatting is different, print its+ source.+ -l,--print-paths If a file's formatting is different, print its path.+ -w,--write-sources If a file's formatting is different, overwrite it.+ FILE Explicit paths to process.+ - A single '-' will process standard input.+ - Files will be processed directly.+ - Directories will be recursively searched for source files to process.+ - .cabal files will be parsed and all specified source directories and files processed.+ - If no paths are given, the current directory will be searched for .cabal files to process, if none are found the current directory will be recursively searched for source files to process.++ Exit Codes:+ 0 = No error+ 1 = Encountered I/O or other operational error+ 2 = Failed to parse a source code file+ 3 = Source code was parsed but cannot be formatted properly+ 4 = Formatted code differs from existing source (--print-diffs only)
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
app/Actions.hs view
@@ -1,41 +1,41 @@-module Actions - ( act - ) where - -import Language.Haskell.Format -import Language.Haskell.Format.Utilities -import Options -import Types - -import Control.Monad - -act :: Options -> Formatted -> IO Formatted -act options r@(Formatted input source result) = act' (optAction options) - where - act' PrintDiffs = - when wasReformatted' (printDiff input source result) >> return r - act' PrintSources = do - when wasReformatted' (printSource $ reformattedSource result) - return (Formatted input (reformattedSource result) result) - act' PrintFilePaths = when wasReformatted' (print input) >> return r - act' WriteSources = do - when wasReformatted' (writeSource input (reformattedSource result)) - return (Formatted input (reformattedSource result) result) - wasReformatted' = wasReformatted source result - -printDiff :: SourceFile -> HaskellSource -> Reformatted -> IO () -printDiff (SourceFilePath path) source reformatted = do - putStrLn (path ++ ":") - mapM_ (putStr . show) (suggestions reformatted) - putStr (showDiff source (reformattedSource reformatted)) -printDiff StdinSource source reformatted = do - mapM_ (putStr . show) (suggestions reformatted) - putStr (showDiff source (reformattedSource reformatted)) - -printSource :: HaskellSource -> IO () -printSource (HaskellSource _ source) = putStr source - -writeSource :: SourceFile -> HaskellSource -> IO () -writeSource (SourceFilePath path) (HaskellSource _ source) = - writeFile path source -writeSource StdinSource (HaskellSource _ source) = putStr source +module Actions+ ( act+ ) where++import Language.Haskell.Format+import Language.Haskell.Format.Utilities+import Options+import Types++import Control.Monad++act :: Options -> Formatted -> IO Formatted+act options r@(Formatted input source result) = act' (optAction options)+ where+ act' PrintDiffs =+ when wasReformatted' (printDiff input source result) >> return r+ act' PrintSources = do+ when wasReformatted' (printSource $ reformattedSource result)+ return (Formatted input (reformattedSource result) result)+ act' PrintFilePaths = when wasReformatted' (print input) >> return r+ act' WriteSources = do+ when wasReformatted' (writeSource input (reformattedSource result))+ return (Formatted input (reformattedSource result) result)+ wasReformatted' = wasReformatted source result++printDiff :: SourceFile -> HaskellSource -> Reformatted -> IO ()+printDiff (SourceFilePath path) source reformatted = do+ putStrLn (path ++ ":")+ mapM_ (putStr . show) (suggestions reformatted)+ putStr (showDiff source (reformattedSource reformatted))+printDiff StdinSource source reformatted = do+ mapM_ (putStr . show) (suggestions reformatted)+ putStr (showDiff source (reformattedSource reformatted))++printSource :: HaskellSource -> IO ()+printSource (HaskellSource _ source) = putStr source++writeSource :: SourceFile -> HaskellSource -> IO ()+writeSource (SourceFilePath path) (HaskellSource _ source) =+ writeFile path source+writeSource StdinSource (HaskellSource _ source) = putStr source
app/ExitCode.hs view
@@ -1,48 +1,48 @@-module ExitCode - ( exitCode - , helpDoc - , operationalFailureCode - , sourceParseFailureCode - ) where - -import Types - -import System.Exit -import Text.PrettyPrint.ANSI.Leijen - --- | Decide which exit code to use --- --- Assume if we are printing diffs that we *are* being run in a CI and so --- should exit with failure if any format differences were found. Otherwise --- assume we are being run in a context where non-zero exit indicates --- failure of the tool to operate properly. -exitCode :: Action -> RunResult -> ExitCode -exitCode _ NoDifferences = ExitSuccess -exitCode PrintDiffs HadDifferences = ExitFailure formattedCodeDiffersFailureCode -exitCode _ HadDifferences = ExitSuccess -exitCode _ SourceParseFailure = ExitFailure sourceParseFailureCode -exitCode _ OperationalFailure = ExitFailure operationalFailureCode - -helpDoc :: Doc -helpDoc = - vsep - [ text "Exit Codes:" - , text " 0 = No error" - , text " 1 = Encountered I/O or other operational error" - , text " 2 = Failed to parse a source code file" - , text " 3 = Source code was parsed but cannot be formatted properly" - , text - " 4 = Formatted code differs from existing source (--print-diffs only)" - ] - --- | Encountered I/O or other operational error -operationalFailureCode :: Int -operationalFailureCode = 1 - --- | Failed to parse a source code file -sourceParseFailureCode :: Int -sourceParseFailureCode = 2 - --- | Formatted code differs from existing source code -formattedCodeDiffersFailureCode :: Int -formattedCodeDiffersFailureCode = 4 +module ExitCode+ ( exitCode+ , helpDoc+ , operationalFailureCode+ , sourceParseFailureCode+ ) where++import Types++import System.Exit+import Text.PrettyPrint.ANSI.Leijen++-- | Decide which exit code to use+--+-- Assume if we are printing diffs that we *are* being run in a CI and so+-- should exit with failure if any format differences were found. Otherwise+-- assume we are being run in a context where non-zero exit indicates+-- failure of the tool to operate properly.+exitCode :: Action -> RunResult -> ExitCode+exitCode _ NoDifferences = ExitSuccess+exitCode PrintDiffs HadDifferences = ExitFailure formattedCodeDiffersFailureCode+exitCode _ HadDifferences = ExitSuccess+exitCode _ SourceParseFailure = ExitFailure sourceParseFailureCode+exitCode _ OperationalFailure = ExitFailure operationalFailureCode++helpDoc :: Doc+helpDoc =+ vsep+ [ text "Exit Codes:"+ , text " 0 = No error"+ , text " 1 = Encountered I/O or other operational error"+ , text " 2 = Failed to parse a source code file"+ , text " 3 = Source code was parsed but cannot be formatted properly"+ , text+ " 4 = Formatted code differs from existing source (--print-diffs only)"+ ]++-- | Encountered I/O or other operational error+operationalFailureCode :: Int+operationalFailureCode = 1++-- | Failed to parse a source code file+sourceParseFailureCode :: Int+sourceParseFailureCode = 2++-- | Formatted code differs from existing source code+formattedCodeDiffersFailureCode :: Int+formattedCodeDiffersFailureCode = 4
app/Main.hs view
@@ -1,76 +1,76 @@-{-# LANGUAGE Rank2Types #-} - -module Main - ( main - ) where - -import Actions -import ExitCode -import Language.Haskell.Format -import Language.Haskell.Format.Utilities -import Language.Haskell.Source.Enumerator -import Options -import Types - -import Conduit -import Options.Applicative.Extra as OptApp -import System.Directory -import System.Exit -import System.IO - -main :: IO () -main = do - options <- execParser Options.parser - result <- run options - exitWith $ exitCode (optAction options) result - -run :: Options -> IO RunResult -run opt = - runConduit $ - sources opt .| mapMC readSource .| mapMC formatSource .| mapMC doAction .| - foldMapMC toRunResult - where - formatSource source = do - formatter <- defaultFormatter - return $ applyFormatter formatter source - doAction :: FormatResult -> IO FormatResult - doAction = bimapM return (Actions.act opt) - toRunResult :: FormatResult -> IO RunResult - toRunResult (Left err) = do - hPrint stderr (show err) - return SourceParseFailure - toRunResult (Right (Formatted _ source result)) = - if wasReformatted source result - then return HadDifferences - else return NoDifferences - -sources :: Options -> ConduitT () SourceFile IO () -sources opt = lift paths >>= mapM_ sourcesFromPath - where - explicitPaths = optPaths opt - paths = - if null explicitPaths - then do - currentPath <- getCurrentDirectory - return [currentPath] - else return explicitPaths - -sourcesFromPath :: FilePath -> ConduitT () SourceFile IO () -sourcesFromPath "-" = yield StdinSource -sourcesFromPath path = enumeratePath path .| mapC SourceFilePath - -readSource :: SourceFile -> IO SourceFileWithContents -readSource s@(SourceFilePath path) = - SourceFileWithContents s . HaskellSource path <$> readFile path -readSource s@StdinSource = - SourceFileWithContents s . HaskellSource "stdin" <$> getContents - -applyFormatter :: Formatter -> SourceFileWithContents -> FormatResult -applyFormatter (Formatter doFormat) (SourceFileWithContents file contents) = - case doFormat contents of - Left err -> Left (FormatError file err) - Right reformat -> Right (Formatted file contents reformat) - -bimapM :: Monad m => (a -> m c) -> (b -> m d) -> Either a b -> m (Either c d) -bimapM f _ (Left a) = Left <$> f a -bimapM _ g (Right b) = Right <$> g b +{-# LANGUAGE Rank2Types #-}++module Main+ ( main+ ) where++import Actions+import ExitCode+import Language.Haskell.Format+import Language.Haskell.Format.Utilities+import Language.Haskell.Source.Enumerator+import Options+import Types++import Conduit+import Options.Applicative.Extra as OptApp+import System.Directory+import System.Exit+import System.IO++main :: IO ()+main = do+ options <- execParser Options.parser+ result <- run options+ exitWith $ exitCode (optAction options) result++run :: Options -> IO RunResult+run opt =+ runConduit $+ sources opt .| mapMC readSource .| mapMC formatSource .| mapMC doAction .|+ foldMapMC toRunResult+ where+ formatSource source = do+ formatter <- defaultFormatter+ return $ applyFormatter formatter source+ doAction :: FormatResult -> IO FormatResult+ doAction = bimapM return (Actions.act opt)+ toRunResult :: FormatResult -> IO RunResult+ toRunResult (Left err) = do+ hPrint stderr (show err)+ return SourceParseFailure+ toRunResult (Right (Formatted _ source result)) =+ if wasReformatted source result+ then return HadDifferences+ else return NoDifferences++sources :: Options -> ConduitT () SourceFile IO ()+sources opt = lift paths >>= mapM_ sourcesFromPath+ where+ explicitPaths = optPaths opt+ paths =+ if null explicitPaths+ then do+ currentPath <- getCurrentDirectory+ return [currentPath]+ else return explicitPaths++sourcesFromPath :: FilePath -> ConduitT () SourceFile IO ()+sourcesFromPath "-" = yield StdinSource+sourcesFromPath path = enumeratePath path .| mapC SourceFilePath++readSource :: SourceFile -> IO SourceFileWithContents+readSource s@(SourceFilePath path) =+ SourceFileWithContents s . HaskellSource path <$> readFile path+readSource s@StdinSource =+ SourceFileWithContents s . HaskellSource "stdin" <$> getContents++applyFormatter :: Formatter -> SourceFileWithContents -> FormatResult+applyFormatter (Formatter doFormat) (SourceFileWithContents file contents) =+ case doFormat contents of+ Left err -> Left (FormatError file err)+ Right reformat -> Right (Formatted file contents reformat)++bimapM :: Monad m => (a -> m c) -> (b -> m d) -> Either a b -> m (Either c d)+bimapM f _ (Left a) = Left <$> f a+bimapM _ g (Right b) = Right <$> g b
app/Options.hs view
@@ -1,83 +1,83 @@-module Options - ( Options - , optAction - , optPaths - , parser - ) where - -import qualified ExitCode -import Types - -import Control.Applicative -import Data.Monoid -import Options.Applicative.Builder -import Options.Applicative.Common -import Options.Applicative.Extra -import Text.PrettyPrint.ANSI.Leijen as Leijen hiding ((<$>), (<>)) - -data Options = Options - { optPrintDiffs :: Bool - , optPrintSources :: Bool - , optPrintFilePaths :: Bool - , optWriteSources :: Bool - , optPaths :: [FilePath] - } - -optAction :: Options -> Action -optAction options - | optPrintDiffs options = PrintDiffs - | optPrintFilePaths options = PrintFilePaths - | optPrintSources options = PrintSources - | optWriteSources options = WriteSources - | optPaths options == ["-"] = PrintSources - | otherwise = PrintDiffs - -optionParser :: Parser Options -optionParser = - Options <$> - switch - (long "print-diffs" <> short 'd' <> - help "If a file's formatting is different, print a diff.") <*> - switch - (long "print-sources" <> short 's' <> hidden <> - help "If a file's formatting is different, print its source.") <*> - switch - (long "print-paths" <> short 'l' <> hidden <> - help "If a file's formatting is different, print its path.") <*> - switch - (long "write-sources" <> short 'w' <> hidden <> - help "If a file's formatting is different, overwrite it.") <*> - many pathOption - where - pathOption = strArgument (metavar "FILE" <> pathOptionHelp) - pathOptionHelp = - helpDoc $ - Just $ - text "Explicit paths to process." <> line <> - unorderdedList - " - " - [ text "A single '-' will process standard input." - , text "Files will be processed directly." - , text - "Directories will be recursively searched for source files to process." - , text - ".cabal files will be parsed and all specified source directories and files processed." - , text - "If no paths are given, the current directory will be searched for .cabal files to process, if none are found the current directory will be recursively searched for source files to process." - ] - -unorderdedList :: String -> [Doc] -> Doc -unorderdedList prefix = vsep . map ((text prefix <>) . align) - -optionParserInfo :: ParserInfo Options -optionParserInfo = - info - (helper <*> optionParser) - (fullDesc <> header "hfmt - Format Haskell programs" <> - progDesc - "Reformats Haskell source files by applying HLint, hindent, and stylish-haskell." <> - footerDoc (Just ExitCode.helpDoc) <> - failureCode ExitCode.operationalFailureCode) - -parser :: ParserInfo Options -parser = optionParserInfo +module Options+ ( Options+ , optAction+ , optPaths+ , parser+ ) where++import qualified ExitCode+import Types++import Control.Applicative+import Data.Semigroup ((<>))+import Options.Applicative.Builder+import Options.Applicative.Common+import Options.Applicative.Extra+import Text.PrettyPrint.ANSI.Leijen as Leijen hiding ((<$>), (<>))++data Options = Options+ { optPrintDiffs :: Bool+ , optPrintSources :: Bool+ , optPrintFilePaths :: Bool+ , optWriteSources :: Bool+ , optPaths :: [FilePath]+ }++optAction :: Options -> Action+optAction options+ | optPrintDiffs options = PrintDiffs+ | optPrintFilePaths options = PrintFilePaths+ | optPrintSources options = PrintSources+ | optWriteSources options = WriteSources+ | optPaths options == ["-"] = PrintSources+ | otherwise = PrintDiffs++optionParser :: Parser Options+optionParser =+ Options <$>+ switch+ (long "print-diffs" <> short 'd' <>+ help "If a file's formatting is different, print a diff.") <*>+ switch+ (long "print-sources" <> short 's' <> hidden <>+ help "If a file's formatting is different, print its source.") <*>+ switch+ (long "print-paths" <> short 'l' <> hidden <>+ help "If a file's formatting is different, print its path.") <*>+ switch+ (long "write-sources" <> short 'w' <> hidden <>+ help "If a file's formatting is different, overwrite it.") <*>+ many pathOption+ where+ pathOption = strArgument (metavar "FILE" <> pathOptionHelp)+ pathOptionHelp =+ helpDoc $+ Just $+ text "Explicit paths to process." <> line <>+ unorderdedList+ " - "+ [ text "A single '-' will process standard input."+ , text "Files will be processed directly."+ , text+ "Directories will be recursively searched for source files to process."+ , text+ ".cabal files will be parsed and all specified source directories and files processed."+ , text+ "If no paths are given, the current directory will be searched for .cabal files to process, if none are found the current directory will be recursively searched for source files to process."+ ]++unorderdedList :: String -> [Doc] -> Doc+unorderdedList prefix = vsep . map ((text prefix <>) . align)++optionParserInfo :: ParserInfo Options+optionParserInfo =+ info+ (helper <*> optionParser)+ (fullDesc <> header "hfmt - Format Haskell programs" <>+ progDesc+ "Reformats Haskell source files by applying HLint, hindent, and stylish-haskell." <>+ footerDoc (Just ExitCode.helpDoc) <>+ failureCode ExitCode.operationalFailureCode)++parser :: ParserInfo Options+parser = optionParserInfo
app/Types.hs view
@@ -1,60 +1,64 @@-module Types - ( Action(..) - , FormatResult - , FormatError(..) - , Formatted(..) - , HaskellSource(..) - , RunResult(..) - , SourceFile(..) - , SourceFileWithContents(..) - ) where - -import Language.Haskell.Format - -data Action - = PrintDiffs - | PrintSources - | PrintFilePaths - | WriteSources - deriving (Eq) - -data SourceFile - = SourceFilePath FilePath - | StdinSource - -instance Show SourceFile where - show (SourceFilePath path) = path - show StdinSource = "-" - -data SourceFileWithContents = - SourceFileWithContents SourceFile - HaskellSource - -type FormatResult = Either FormatError Formatted - -data FormatError = - FormatError SourceFile - String - -instance Show FormatError where - show (FormatError input errorString) = - "Error reformatting " ++ show input ++ ": " ++ errorString - -data Formatted = - Formatted SourceFile - HaskellSource - Reformatted - -data RunResult - = OperationalFailure - | SourceParseFailure - | HadDifferences - | NoDifferences - -instance Monoid RunResult where - mempty = NoDifferences - x `mappend` NoDifferences = x - NoDifferences `mappend` x = x - OperationalFailure `mappend` _ = OperationalFailure - SourceParseFailure `mappend` _ = SourceParseFailure - HadDifferences `mappend` _ = HadDifferences +module Types+ ( Action(..)+ , FormatResult+ , FormatError(..)+ , Formatted(..)+ , HaskellSource(..)+ , RunResult(..)+ , SourceFile(..)+ , SourceFileWithContents(..)+ ) where++import Data.Semigroup (Semigroup, (<>))+import Language.Haskell.Format++data Action+ = PrintDiffs+ | PrintSources+ | PrintFilePaths+ | WriteSources+ deriving (Eq)++data SourceFile+ = SourceFilePath FilePath+ | StdinSource++instance Show SourceFile where+ show (SourceFilePath path) = path+ show StdinSource = "-"++data SourceFileWithContents =+ SourceFileWithContents SourceFile+ HaskellSource++type FormatResult = Either FormatError Formatted++data FormatError =+ FormatError SourceFile+ String++instance Show FormatError where+ show (FormatError input errorString) =+ "Error reformatting " ++ show input ++ ": " ++ errorString++data Formatted =+ Formatted SourceFile+ HaskellSource+ Reformatted++data RunResult+ = OperationalFailure+ | SourceParseFailure+ | HadDifferences+ | NoDifferences++instance Semigroup RunResult where+ x <> NoDifferences = x+ NoDifferences <> x = x+ OperationalFailure <> _ = OperationalFailure+ SourceParseFailure <> _ = SourceParseFailure+ HadDifferences <> _ = HadDifferences++instance Monoid RunResult where+ mempty = NoDifferences+ mappend = (<>)
hfmt.cabal view
@@ -1,89 +1,89 @@-name: hfmt -version: 0.2.2 -synopsis: Haskell source code formatter -description: Inspired by gofmt. Built using hlint, hindent, and stylish-haskell. -license: MIT -license-file: LICENSE -author: Daniel Stiner -maintainer: Daniel Stiner <daniel.stiner@gmail.com> -stability: Experimental -homepage: http://github.com/danstiner/hfmt -bug-reports: http://github.com/danstiner/hfmt/issues -category: Language -build-type: Simple -extra-source-files: README.md, .stylish-haskell.yaml -cabal-version: >=1.9.2 -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.5 - -library - Hs-Source-Dirs: src - Exposed-Modules: Language.Haskell.Format - , Language.Haskell.Format.Utilities - , Language.Haskell.Source.Enumerator - Other-Modules: Language.Haskell.Format.Internal - , Language.Haskell.Format.HIndent - , Language.Haskell.Format.HLint - , Language.Haskell.Format.Stylish - , Language.Haskell.Format.Types - , Path.Find - GHC-Options: -Wall - Build-Depends: base >= 4.8 && < 5 - , bytestring - , Cabal - , conduit - , conduit-combinators - , Diff - , directory - , exceptions - , filepath - , haskell-src-exts > 1.20 - , hindent == 5.* - , hlint == 2.* - , HUnit - , path - , path-io - , pretty - , stylish-haskell == 0.9.* - , text - , transformers - , yaml - -executable hfmt - Hs-Source-Dirs: app - Main-Is: Main.hs - Other-Modules: Actions - , ExitCode - , Options - , Types - GHC-Options: -Wall - Build-Depends: base >= 4.8 && < 5 - , conduit - , conduit-combinators - , directory - , hfmt - , ansi-wl-pprint - , optparse-applicative - -test-suite self-formatting-test - Type: exitcode-stdio-1.0 - Hs-Source-Dirs: test/self-formatting - Main-Is: Spec.hs - Build-Depends: base == 4.* - , hfmt - , HUnit - , test-framework - , test-framework-hunit - -test-suite pure-test - Type: exitcode-stdio-1.0 - Hs-Source-Dirs: test/pure - Main-Is: Spec.hs - Build-Depends: base == 4.* - , hfmt - , HUnit - , test-framework - , test-framework-hunit - -source-repository head - type: git - location: git://github.com:danstiner/hfmt.git +name: hfmt+version: 0.2.3.0+synopsis: Haskell source code formatter+description: Inspired by gofmt. Built using hlint, hindent, and stylish-haskell.+license: MIT+license-file: LICENSE+author: Daniel Stiner+maintainer: Daniel Stiner <daniel.stiner@gmail.com>+stability: Experimental+homepage: http://github.com/danstiner/hfmt+bug-reports: http://github.com/danstiner/hfmt/issues+category: Language+build-type: Simple+extra-source-files: README.md, .stylish-haskell.yaml+cabal-version: >=1.9.2+tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2, GHC == 8.5++library+ Hs-Source-Dirs: src+ Exposed-Modules: Language.Haskell.Format+ , Language.Haskell.Format.Utilities+ , Language.Haskell.Source.Enumerator+ Other-Modules: Language.Haskell.Format.Internal+ , Language.Haskell.Format.HIndent+ , Language.Haskell.Format.HLint+ , Language.Haskell.Format.Stylish+ , Language.Haskell.Format.Types+ , Path.Find+ GHC-Options: -Wall+ Build-Depends: base >= 4.8 && < 5+ , bytestring+ , Cabal+ , conduit+ , conduit-combinators+ , Diff+ , directory+ , exceptions+ , filepath+ , haskell-src-exts > 1.20+ , hindent == 5.*+ , hlint == 2.*+ , HUnit+ , path+ , path-io+ , pretty+ , stylish-haskell == 0.9.*+ , text+ , transformers+ , yaml++executable hfmt+ Hs-Source-Dirs: app+ Main-Is: Main.hs+ Other-Modules: Actions+ , ExitCode+ , Options+ , Types+ GHC-Options: -Wall+ Build-Depends: base >= 4.8 && < 5+ , conduit+ , conduit-combinators+ , directory+ , hfmt+ , ansi-wl-pprint+ , optparse-applicative++test-suite self-formatting-test+ Type: exitcode-stdio-1.0+ Hs-Source-Dirs: test/self-formatting+ Main-Is: Spec.hs+ Build-Depends: base == 4.*+ , hfmt+ , HUnit+ , test-framework+ , test-framework-hunit++test-suite pure-test+ Type: exitcode-stdio-1.0+ Hs-Source-Dirs: test/pure+ Main-Is: Spec.hs+ Build-Depends: base == 4.*+ , hfmt+ , HUnit+ , test-framework+ , test-framework-hunit++source-repository head+ type: git+ location: git://github.com:danstiner/hfmt.git
src/Language/Haskell/Format.hs view
@@ -1,39 +1,49 @@-module Language.Haskell.Format - ( autoSettings - , format - , formatters - , hlint - , hindent - , stylish - , Settings - , Formatter(..) - , Suggestion(..) - , HaskellSource(..) - , Reformatted(..) - ) where - -import qualified Language.Haskell.Format.HIndent as HIndent -import qualified Language.Haskell.Format.HLint as HLint -import qualified Language.Haskell.Format.Stylish as Stylish -import Language.Haskell.Format.Types - -data Settings = - Settings - -autoSettings :: IO Settings -autoSettings = return Settings - -hlint :: Settings -> IO Formatter -hlint _ = HLint.suggester <$> HLint.autoSettings - -hindent :: Settings -> IO Formatter -hindent _ = HIndent.formatter <$> HIndent.autoSettings - -stylish :: Settings -> IO Formatter -stylish _ = Stylish.formatter <$> Stylish.autoSettings - -formatters :: Settings -> IO [Formatter] -formatters s = sequence [hlint s, hindent s, stylish s] - -format :: Formatter -> HaskellSource -> Either String Reformatted -format = unFormatter +module Language.Haskell.Format+ ( autoSettings+ , format+ , formatters+ , hlint+ , hindent+ , stylish+ , Settings+ , Formatter(..)+ , Suggestion(..)+ , HaskellSource(..)+ , Reformatted(..)+ ) where++import qualified Language.Haskell.Format.HIndent as HIndent+import qualified Language.Haskell.Format.HLint as HLint+import qualified Language.Haskell.Format.Stylish as Stylish+import Language.Haskell.Format.Types++data Settings =+ Settings++autoSettings :: IO Settings+autoSettings = return Settings++hlint :: Settings -> IO Formatter+hlint _ = HLint.suggester <$> HLint.autoSettings++hindent :: Settings -> IO Formatter+hindent _ = HIndent.formatter <$> HIndent.autoSettings++stylish :: Settings -> IO Formatter+stylish _ = Stylish.formatter <$> Stylish.autoSettings++errorFor :: String -> Formatter -> Formatter+errorFor name (Formatter formatter) =+ Formatter $ \source -> prefixName (formatter source)+ where+ prefixName (Left err) = Left ("Error in " ++ name ++ ": " ++ err)+ prefixName (Right a) = Right a++formatters :: Settings -> IO [Formatter]+formatters s = traverse (\(name, f) -> fmap (errorFor name) (f s)) named+ where+ named =+ [("hlint", hlint), ("hindent", hindent), ("stylish-haskell", stylish)]++format :: Formatter -> HaskellSource -> Either String Reformatted+format = unFormatter
src/Language/Haskell/Format/HIndent.hs view
@@ -1,62 +1,62 @@-module Language.Haskell.Format.HIndent - ( autoSettings - , formatter - , defaultFormatter - ) where - -import Data.ByteString.Builder -import Data.ByteString.Lazy as L -import qualified Data.Text as Text -import Data.Text.Encoding as Encoding -import qualified Data.Yaml as Y -import HIndent -import HIndent.Types -import Language.Haskell.Exts.Extension (Extension) -import Path -import qualified Path.Find as Path -import qualified Path.IO as Path - -import Language.Haskell.Format.Internal -import Language.Haskell.Format.Types - -data Settings = - Settings Config - (Maybe [Extension]) - -defaultFormatter :: IO Formatter -defaultFormatter = formatter <$> autoSettings - -autoSettings :: IO Settings -autoSettings = do - config <- getConfig - return $ Settings config $ Just defaultExtensions - --- | Read config from a config file, or return 'defaultConfig'. -getConfig :: IO Config -getConfig = do - cur <- Path.getCurrentDir - homeDir <- Path.getHomeDir - mfile <- - Path.findFileUp - cur - ((== ".hindent.yaml") . toFilePath . filename) - (Just homeDir) - case mfile of - Nothing -> return defaultConfig - Just file -> do - result <- Y.decodeFileEither (toFilePath file) - case result of - Left e -> error (show e) - Right config -> return config - -formatter :: Settings -> Formatter -formatter = mkFormatter . hindent - -hindent :: Settings -> HaskellSource -> Either String HaskellSource -hindent (Settings config extensions) (HaskellSource filepath source) = - HaskellSource filepath . unpackBuilder <$> - reformat config extensions Nothing sourceText - where - sourceText = Encoding.encodeUtf8 . Text.pack $ source - unpackBuilder = - Text.unpack . Encoding.decodeUtf8 . L.toStrict . toLazyByteString +module Language.Haskell.Format.HIndent+ ( autoSettings+ , formatter+ , defaultFormatter+ ) where++import Data.ByteString.Builder+import Data.ByteString.Lazy as L+import qualified Data.Text as Text+import Data.Text.Encoding as Encoding+import qualified Data.Yaml as Y+import HIndent+import HIndent.Types+import Language.Haskell.Exts.Extension (Extension)+import Path+import qualified Path.Find as Path+import qualified Path.IO as Path++import Language.Haskell.Format.Internal+import Language.Haskell.Format.Types++data Settings =+ Settings Config+ (Maybe [Extension])++defaultFormatter :: IO Formatter+defaultFormatter = formatter <$> autoSettings++autoSettings :: IO Settings+autoSettings = do+ config <- getConfig+ return $ Settings config $ Just defaultExtensions++-- | Read config from a config file, or return 'defaultConfig'.+getConfig :: IO Config+getConfig = do+ cur <- Path.getCurrentDir+ homeDir <- Path.getHomeDir+ mfile <-+ Path.findFileUp+ cur+ ((== ".hindent.yaml") . toFilePath . filename)+ (Just homeDir)+ case mfile of+ Nothing -> return defaultConfig+ Just file -> do+ result <- Y.decodeFileEither (toFilePath file)+ case result of+ Left e -> error (show e)+ Right config -> return config++formatter :: Settings -> Formatter+formatter = mkFormatter . hindent++hindent :: Settings -> HaskellSource -> Either String HaskellSource+hindent (Settings config extensions) (HaskellSource filepath source) =+ HaskellSource filepath . unpackBuilder <$>+ reformat config extensions Nothing sourceText+ where+ sourceText = Encoding.encodeUtf8 . Text.pack $ source+ unpackBuilder =+ Text.unpack . Encoding.decodeUtf8 . L.toStrict . toLazyByteString
src/Language/Haskell/Format/HLint.hs view
@@ -1,33 +1,33 @@-module Language.Haskell.Format.HLint - ( autoSettings - , suggester - ) where - -import Language.Haskell.Format.Internal -import Language.Haskell.Format.Types - -import Language.Haskell.HLint3 (Classify, Hint, - ParseError (..), ParseFlags, - applyHints, parseModuleEx) -import qualified Language.Haskell.HLint3 as HLint3 -import System.IO.Unsafe (unsafePerformIO) - -suggester :: (ParseFlags, [Classify], Hint) -> Formatter -suggester = mkSuggester . hlint - -hlint :: - (ParseFlags, [Classify], Hint) - -> HaskellSource - -> Either String [Suggestion] -hlint (flags, classify, hint) (HaskellSource filepath source) = - case unsafePerformIO (parseModuleEx flags filepath (Just source)) of - Right m -> Right . map ideaToSuggestion . ideas $ m - Left parseError -> Left . parseErrorMessage $ parseError - where - ideas m = applyHints classify hint [m] - -autoSettings :: IO (ParseFlags, [Classify], Hint) -autoSettings = HLint3.autoSettings - -ideaToSuggestion :: HLint3.Idea -> Suggestion -ideaToSuggestion = Suggestion . show +module Language.Haskell.Format.HLint+ ( autoSettings+ , suggester+ ) where++import Language.Haskell.Format.Internal+import Language.Haskell.Format.Types++import Language.Haskell.HLint3 (Classify, Hint,+ ParseError (..), ParseFlags,+ applyHints, parseModuleEx)+import qualified Language.Haskell.HLint3 as HLint3+import System.IO.Unsafe (unsafePerformIO)++suggester :: (ParseFlags, [Classify], Hint) -> Formatter+suggester = mkSuggester . hlint++hlint ::+ (ParseFlags, [Classify], Hint)+ -> HaskellSource+ -> Either String [Suggestion]+hlint (flags, classify, hint) (HaskellSource filepath source) =+ case unsafePerformIO (parseModuleEx flags filepath (Just source)) of+ Right m -> Right . map ideaToSuggestion . ideas $ m+ Left parseError -> Left . parseErrorMessage $ parseError+ where+ ideas m = applyHints classify hint [m]++autoSettings :: IO (ParseFlags, [Classify], Hint)+autoSettings = HLint3.argsSettings []++ideaToSuggestion :: HLint3.Idea -> Suggestion+ideaToSuggestion = Suggestion . show
src/Language/Haskell/Format/Internal.hs view
@@ -1,12 +1,12 @@-module Language.Haskell.Format.Internal - ( mkFormatter - , mkSuggester - ) where - -import Language.Haskell.Format.Types - -mkFormatter :: (HaskellSource -> Either String HaskellSource) -> Formatter -mkFormatter f = Formatter (fmap (\source -> Reformatted source []) . f) - -mkSuggester :: (HaskellSource -> Either String [Suggestion]) -> Formatter -mkSuggester f = Formatter $ \source -> Reformatted source <$> f source +module Language.Haskell.Format.Internal+ ( mkFormatter+ , mkSuggester+ ) where++import Language.Haskell.Format.Types++mkFormatter :: (HaskellSource -> Either String HaskellSource) -> Formatter+mkFormatter f = Formatter (fmap (\source -> Reformatted source []) . f)++mkSuggester :: (HaskellSource -> Either String [Suggestion]) -> Formatter+mkSuggester f = Formatter $ \source -> Reformatted source <$> f source
src/Language/Haskell/Format/Stylish.hs view
@@ -1,32 +1,32 @@-module Language.Haskell.Format.Stylish - ( autoSettings - , formatter - ) where - -import Language.Haskell.Stylish as Stylish - -import Language.Haskell.Format.Internal -import Language.Haskell.Format.Types - -newtype Settings = - Settings Stylish.Config - -autoSettings :: IO Settings -autoSettings = do - path <- Stylish.configFilePath verbose Nothing - config <- Stylish.loadConfig verbose path - return (Settings config) - where - verbose = Stylish.makeVerbose False - -formatter :: Settings -> Formatter -formatter = mkFormatter . stylish - -stylish :: Settings -> HaskellSource -> Either String HaskellSource -stylish (Settings config) (HaskellSource filepath source) = - HaskellSource filepath . unlines <$> - Stylish.runSteps extensions (Just filepath) steps sourceLines - where - sourceLines = lines source - extensions = Stylish.configLanguageExtensions config - steps = Stylish.configSteps config +module Language.Haskell.Format.Stylish+ ( autoSettings+ , formatter+ ) where++import Language.Haskell.Stylish as Stylish++import Language.Haskell.Format.Internal+import Language.Haskell.Format.Types++newtype Settings =+ Settings Stylish.Config++autoSettings :: IO Settings+autoSettings = do+ path <- Stylish.configFilePath verbose Nothing+ config <- Stylish.loadConfig verbose path+ return (Settings config)+ where+ verbose = Stylish.makeVerbose False++formatter :: Settings -> Formatter+formatter = mkFormatter . stylish++stylish :: Settings -> HaskellSource -> Either String HaskellSource+stylish (Settings config) (HaskellSource filepath source) =+ HaskellSource filepath . unlines <$>+ Stylish.runSteps extensions (Just filepath) steps sourceLines+ where+ sourceLines = lines source+ extensions = Stylish.configLanguageExtensions config+ steps = Stylish.configSteps config
src/Language/Haskell/Format/Types.hs view
@@ -1,46 +1,52 @@-module Language.Haskell.Format.Types - ( HaskellSource(..) - , Reformatted(..) - , Formatter(..) - , Suggestion(..) - ) where - -import Control.Monad -import Data.Monoid ((<>)) - -type ErrorString = String - -data HaskellSource = - HaskellSource FilePath - String - deriving (Eq) - -newtype Suggestion = - Suggestion String - -instance Show Suggestion where - show (Suggestion text) = text - -data Reformatted = Reformatted - { reformattedSource :: HaskellSource - , suggestions :: [Suggestion] - } - -instance Monoid Reformatted where - mempty = Reformatted undefined [] - (Reformatted _ suggestionsA) `mappend` (Reformatted sourceB suggestionsB) = - Reformatted sourceB (suggestionsA <> suggestionsB) - -newtype Formatter = Formatter - { unFormatter :: HaskellSource -> Either ErrorString Reformatted - } - -instance Monoid Formatter where - mempty = Formatter (\source -> Right (Reformatted source [])) - (Formatter f) `mappend` (Formatter g) = Formatter (asReformatter g <=< f) - -asReformatter :: - (HaskellSource -> Either ErrorString Reformatted) - -> Reformatted - -> Either ErrorString Reformatted -asReformatter formatter r = (r <>) <$> formatter (reformattedSource r) +module Language.Haskell.Format.Types+ ( HaskellSource(..)+ , Reformatted(..)+ , Formatter(..)+ , Suggestion(..)+ ) where++import Control.Monad+import Data.Semigroup (Semigroup, (<>))++type ErrorString = String++data HaskellSource =+ HaskellSource FilePath+ String+ deriving (Eq)++newtype Suggestion =+ Suggestion String++instance Show Suggestion where+ show (Suggestion text) = text++data Reformatted = Reformatted+ { reformattedSource :: HaskellSource+ , suggestions :: [Suggestion]+ }++instance Semigroup Reformatted where+ (Reformatted _ suggestionsA) <> (Reformatted sourceB suggestionsB) =+ Reformatted sourceB (suggestionsA <> suggestionsB)++instance Monoid Reformatted where+ mempty = Reformatted undefined []+ mappend = (<>)++newtype Formatter = Formatter+ { unFormatter :: HaskellSource -> Either ErrorString Reformatted+ }++instance Semigroup Formatter where+ (Formatter f) <> (Formatter g) = Formatter (asReformatter g <=< f)++instance Monoid Formatter where+ mempty = Formatter (\source -> Right (Reformatted source []))+ mappend = (<>)++asReformatter ::+ (HaskellSource -> Either ErrorString Reformatted)+ -> Reformatted+ -> Either ErrorString Reformatted+asReformatter formatter r = (r <>) <$> formatter (reformattedSource r)
src/Language/Haskell/Format/Utilities.hs view
@@ -1,105 +1,105 @@-module Language.Haskell.Format.Utilities - ( defaultFormatter - , hunitTest - , showDiff - , wasReformatted - ) where - -import System.IO.Unsafe - -import Language.Haskell.Format -import Language.Haskell.Source.Enumerator - -import Conduit -import Control.Monad -import Data.Algorithm.DiffContext -import Data.List -import Data.Maybe -import Test.HUnit -import Text.PrettyPrint - -type ErrorString = String - -data CheckResult - = InvalidCheckResult HaskellSource - ErrorString - | CheckResult HaskellSource - Reformatted - -checkResultPath :: CheckResult -> FilePath -checkResultPath (InvalidCheckResult (HaskellSource filepath _) _) = filepath -checkResultPath (CheckResult (HaskellSource filepath _) _) = filepath - -hunitTest :: FilePath -> Test -hunitTest filepath = TestLabel filepath . unsafePerformIO . testPath $ filepath - -testPath :: FilePath -> IO Test -testPath filepath = do - formatter <- defaultFormatter - TestList <$> - runConduit (check formatter filepath .| mapC makeTestCase .| sinkList) - -makeTestCase :: CheckResult -> Test -makeTestCase result = - TestLabel (checkResultPath result) . TestCase $ assertCheckResult result - -assertCheckResult :: CheckResult -> IO () -assertCheckResult result = - case result of - (InvalidCheckResult _ errorString) -> - assertFailure ("Error: " ++ errorString) - (CheckResult source reformatted) -> - when (wasReformatted source reformatted) $ - assertFailure (showReformatted source reformatted) - where - showReformatted :: HaskellSource -> Reformatted -> String - showReformatted source reformatted = - intercalate "\n" $ - catMaybes - [ showSourceChanges source reformatted - , showSuggestions source reformatted - ] - showSourceChanges source reformatted = - whenMaybe - (sourceChanged source reformatted) - (showDiff source (reformattedSource reformatted)) - showSuggestions _ reformatted = - whenMaybe - (hasSuggestions reformatted) - (concatMap show (suggestions reformatted)) - whenMaybe :: Bool -> a -> Maybe a - whenMaybe cond val = const val <$> guard cond - -showDiff :: HaskellSource -> HaskellSource -> String -showDiff (HaskellSource _ a) (HaskellSource _ b) = render (toDoc diff) - where - toDoc = prettyContextDiff (text "Original") (text "Reformatted") text - diff = getContextDiff linesOfContext (lines a) (lines b) - linesOfContext = 1 - -check :: Formatter -> FilePath -> ConduitT () CheckResult IO () -check formatter filepath = - enumeratePath filepath .| mapMC readSourceFile .| - mapC (checkFormatting formatter) - -readSourceFile :: FilePath -> IO HaskellSource -readSourceFile filepath = HaskellSource filepath <$> readFile filepath - -checkFormatting :: Formatter -> HaskellSource -> CheckResult -checkFormatting (Formatter doFormat) source = - case doFormat source of - Left err -> InvalidCheckResult source err - Right reformatted -> CheckResult source reformatted - -defaultFormatter :: IO Formatter -defaultFormatter = mconcat <$> (autoSettings >>= formatters) - -wasReformatted :: HaskellSource -> Reformatted -> Bool -wasReformatted source reformatted = - hasSuggestions reformatted || sourceChanged source reformatted - -sourceChanged :: HaskellSource -> Reformatted -> Bool -sourceChanged source reformatted = source /= reformattedSource reformatted - -hasSuggestions :: Reformatted -> Bool -hasSuggestions reformatted = not (null (suggestions reformatted)) +module Language.Haskell.Format.Utilities+ ( defaultFormatter+ , hunitTest+ , showDiff+ , wasReformatted+ ) where++import System.IO.Unsafe++import Language.Haskell.Format+import Language.Haskell.Source.Enumerator++import Conduit+import Control.Monad+import Data.Algorithm.DiffContext+import Data.List+import Data.Maybe+import Test.HUnit+import Text.PrettyPrint++type ErrorString = String++data CheckResult+ = InvalidCheckResult HaskellSource+ ErrorString+ | CheckResult HaskellSource+ Reformatted++checkResultPath :: CheckResult -> FilePath+checkResultPath (InvalidCheckResult (HaskellSource filepath _) _) = filepath+checkResultPath (CheckResult (HaskellSource filepath _) _) = filepath++hunitTest :: FilePath -> Test+hunitTest filepath = TestLabel filepath . unsafePerformIO . testPath $ filepath++testPath :: FilePath -> IO Test+testPath filepath = do+ formatter <- defaultFormatter+ TestList <$>+ runConduit (check formatter filepath .| mapC makeTestCase .| sinkList)++makeTestCase :: CheckResult -> Test+makeTestCase result =+ TestLabel (checkResultPath result) . TestCase $ assertCheckResult result++assertCheckResult :: CheckResult -> IO ()+assertCheckResult result =+ case result of+ (InvalidCheckResult _ errorString) ->+ assertFailure ("Error: " ++ errorString)+ (CheckResult source reformatted) ->+ when (wasReformatted source reformatted) $+ assertFailure (showReformatted source reformatted)+ where+ showReformatted :: HaskellSource -> Reformatted -> String+ showReformatted source reformatted =+ intercalate "\n" $+ catMaybes+ [ showSourceChanges source reformatted+ , showSuggestions source reformatted+ ]+ showSourceChanges source reformatted =+ whenMaybe+ (sourceChanged source reformatted)+ (showDiff source (reformattedSource reformatted))+ showSuggestions _ reformatted =+ whenMaybe+ (hasSuggestions reformatted)+ (concatMap show (suggestions reformatted))+ whenMaybe :: Bool -> a -> Maybe a+ whenMaybe cond val = const val <$> guard cond++showDiff :: HaskellSource -> HaskellSource -> String+showDiff (HaskellSource _ a) (HaskellSource _ b) = render (toDoc diff)+ where+ toDoc = prettyContextDiff (text "Original") (text "Reformatted") text+ diff = getContextDiff linesOfContext (lines a) (lines b)+ linesOfContext = 1++check :: Formatter -> FilePath -> ConduitT () CheckResult IO ()+check formatter filepath =+ enumeratePath filepath .| mapMC readSourceFile .|+ mapC (checkFormatting formatter)++readSourceFile :: FilePath -> IO HaskellSource+readSourceFile filepath = HaskellSource filepath <$> readFile filepath++checkFormatting :: Formatter -> HaskellSource -> CheckResult+checkFormatting (Formatter doFormat) source =+ case doFormat source of+ Left err -> InvalidCheckResult source err+ Right reformatted -> CheckResult source reformatted++defaultFormatter :: IO Formatter+defaultFormatter = mconcat <$> (autoSettings >>= formatters)++wasReformatted :: HaskellSource -> Reformatted -> Bool+wasReformatted source reformatted =+ hasSuggestions reformatted || sourceChanged source reformatted++sourceChanged :: HaskellSource -> Reformatted -> Bool+sourceChanged source reformatted = source /= reformattedSource reformatted++hasSuggestions :: Reformatted -> Bool+hasSuggestions reformatted = not (null (suggestions reformatted))
src/Language/Haskell/Source/Enumerator.hs view
@@ -1,78 +1,89 @@-module Language.Haskell.Source.Enumerator - ( enumeratePath - ) where - -import Conduit -import Control.Applicative -import Control.Monad -import Data.List -import Distribution.PackageDescription -import Distribution.PackageDescription.Parse -import qualified Distribution.Verbosity as Verbosity -import System.Directory -import System.FilePath - -enumeratePath :: FilePath -> ConduitT () FilePath IO () -enumeratePath path = enumPath path .| mapC normalise - -enumPath :: FilePath -> ConduitT () FilePath IO () -enumPath path = do - isDirectory <- lift $ doesDirectoryExist path - case isDirectory of - True -> enumDirectory path - False - | hasCabalExtension path -> enumPackage path - False - | hasHaskellExtension path -> yield path - False -> return () - -enumPackage :: FilePath -> ConduitT () FilePath IO () -enumPackage cabalFile = readPackage cabalFile >>= expandPaths - where - readPackage = lift . readPackageDescription Verbosity.silent - expandPaths = mapM_ (enumPath . mkFull) . sourcePaths - packageDir = dropFileName cabalFile - mkFull = (packageDir </>) - -enumDirectory :: FilePath -> ConduitT () FilePath IO () -enumDirectory path = do - contents <- lift $ getDirectoryContentFullPaths path - cabalFiles <- lift $ filterM isCabalFile contents - if null cabalFiles - then mapM_ enumPath contents - else mapM_ enumPackage cabalFiles - -getDirectoryContentFullPaths :: FilePath -> IO [FilePath] -getDirectoryContentFullPaths path = - mkFull . notHidden . notMeta <$> getDirectoryContents path - where - mkFull = map (path </>) - notHidden = filter (not . isPrefixOf ".") - notMeta = (\\ [".", ".."]) - -isCabalFile :: FilePath -> IO Bool -isCabalFile path = return (hasCabalExtension path) <&&> doesFileExist path - -hasCabalExtension :: FilePath -> Bool -hasCabalExtension path = ".cabal" `isSuffixOf` path - -hasHaskellExtension :: FilePath -> Bool -hasHaskellExtension path = ".hs" `isSuffixOf` path || ".lhs" `isSuffixOf` path - -sourcePaths :: GenericPackageDescription -> [FilePath] -sourcePaths pkg = nub $ concatMap ($ pkg) pathExtractors - where - pathExtractors = - [ maybe [] (hsSourceDirs . libBuildInfo . condTreeData) . condLibrary - , concatMap (hsSourceDirs . buildInfo . condTreeData . snd) . - condExecutables - , concatMap (hsSourceDirs . testBuildInfo . condTreeData . snd) . - condTestSuites - , concatMap (hsSourceDirs . benchmarkBuildInfo . condTreeData . snd) . - condBenchmarks - ] - -(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool -(<&&>) = liftA2 (&&) - -infixr 3 <&&> -- same as (&&) +{-# LANGUAGE CPP #-}++module Language.Haskell.Source.Enumerator+ ( enumeratePath+ ) where++import Conduit+import Control.Applicative+import Control.Monad+import Data.List+import Distribution.PackageDescription+import qualified Distribution.Verbosity as Verbosity+import System.Directory+import System.FilePath+#if MIN_VERSION_Cabal(2,2,0)+import Distribution.PackageDescription.Parsec (readGenericPackageDescription)+#elif MIN_VERSION_Cabal(2,0,0)+import Distribution.PackageDescription.Parse (readGenericPackageDescription)+#else+import Distribution.PackageDescription.Parse (readPackageDescription)++readGenericPackageDescription ::+ Verbosity.Verbosity -> FilePath -> IO GenericPackageDescription+readGenericPackageDescription = readPackageDescription+#endif+enumeratePath :: FilePath -> ConduitT () FilePath IO ()+enumeratePath path = enumPath path .| mapC normalise++enumPath :: FilePath -> ConduitT () FilePath IO ()+enumPath path = do+ isDirectory <- lift $ doesDirectoryExist path+ case isDirectory of+ True -> enumDirectory path+ False+ | hasCabalExtension path -> enumPackage path+ False+ | hasHaskellExtension path -> yield path+ False -> return ()++enumPackage :: FilePath -> ConduitT () FilePath IO ()+enumPackage cabalFile = readPackage cabalFile >>= expandPaths+ where+ readPackage = lift . readGenericPackageDescription Verbosity.silent+ expandPaths = mapM_ (enumPath . mkFull) . sourcePaths+ packageDir = dropFileName cabalFile+ mkFull = (packageDir </>)++enumDirectory :: FilePath -> ConduitT () FilePath IO ()+enumDirectory path = do+ contents <- lift $ getDirectoryContentFullPaths path+ cabalFiles <- lift $ filterM isCabalFile contents+ if null cabalFiles+ then mapM_ enumPath contents+ else mapM_ enumPackage cabalFiles++getDirectoryContentFullPaths :: FilePath -> IO [FilePath]+getDirectoryContentFullPaths path =+ mkFull . notHidden . notMeta <$> getDirectoryContents path+ where+ mkFull = map (path </>)+ notHidden = filter (not . isPrefixOf ".")+ notMeta = (\\ [".", ".."])++isCabalFile :: FilePath -> IO Bool+isCabalFile path = return (hasCabalExtension path) <&&> doesFileExist path++hasCabalExtension :: FilePath -> Bool+hasCabalExtension path = ".cabal" `isSuffixOf` path++hasHaskellExtension :: FilePath -> Bool+hasHaskellExtension path = ".hs" `isSuffixOf` path || ".lhs" `isSuffixOf` path++sourcePaths :: GenericPackageDescription -> [FilePath]+sourcePaths pkg = nub $ concatMap ($ pkg) pathExtractors+ where+ pathExtractors =+ [ maybe [] (hsSourceDirs . libBuildInfo . condTreeData) . condLibrary+ , concatMap (hsSourceDirs . buildInfo . condTreeData . snd) .+ condExecutables+ , concatMap (hsSourceDirs . testBuildInfo . condTreeData . snd) .+ condTestSuites+ , concatMap (hsSourceDirs . benchmarkBuildInfo . condTreeData . snd) .+ condBenchmarks+ ]++(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool+(<&&>) = liftA2 (&&)++infixr 3 <&&> -- same as (&&)
src/Path/Find.hs view
@@ -1,40 +1,40 @@-{-# LANGUAGE DataKinds #-} - --- | Finding files. --- Lifted from Stack. -module Path.Find - ( findFileUp - ) where - -import Control.Monad.Catch -import Control.Monad.IO.Class -import Data.List -import Path -import Path.IO - --- | Find the location of a file matching the given predicate. -findFileUp :: - (MonadIO m, MonadThrow m) - => Path Abs Dir -- ^ Start here. - -> (Path Abs File -> Bool) -- ^ Predicate to match the file. - -> Maybe (Path Abs Dir) -- ^ Do not ascend above this directory. - -> m (Maybe (Path Abs File)) -- ^ Absolute file path. -findFileUp = findPathUp snd - --- | Find the location of a path matching the given predicate. -findPathUp :: - (MonadIO m, MonadThrow m) - => (([Path Abs Dir], [Path Abs File]) -> [Path Abs t]) - -- ^ Choose path type from pair. - -> Path Abs Dir -- ^ Start here. - -> (Path Abs t -> Bool) -- ^ Predicate to match the path. - -> Maybe (Path Abs Dir) -- ^ Do not ascend above this directory. - -> m (Maybe (Path Abs t)) -- ^ Absolute path. -findPathUp pathType dir p upperBound = do - entries <- listDir dir - case find p (pathType entries) of - Just path -> return (Just path) - Nothing - | Just dir == upperBound -> return Nothing - | parent dir == dir -> return Nothing - | otherwise -> findPathUp pathType (parent dir) p upperBound +{-# LANGUAGE DataKinds #-}++-- | Finding files.+-- Lifted from Stack.+module Path.Find+ ( findFileUp+ ) where++import Control.Monad.Catch+import Control.Monad.IO.Class+import Data.List+import Path+import Path.IO++-- | Find the location of a file matching the given predicate.+findFileUp ::+ (MonadIO m, MonadThrow m)+ => Path Abs Dir -- ^ Start here.+ -> (Path Abs File -> Bool) -- ^ Predicate to match the file.+ -> Maybe (Path Abs Dir) -- ^ Do not ascend above this directory.+ -> m (Maybe (Path Abs File)) -- ^ Absolute file path.+findFileUp = findPathUp snd++-- | Find the location of a path matching the given predicate.+findPathUp ::+ (MonadIO m, MonadThrow m)+ => (([Path Abs Dir], [Path Abs File]) -> [Path Abs t])+ -- ^ Choose path type from pair.+ -> Path Abs Dir -- ^ Start here.+ -> (Path Abs t -> Bool) -- ^ Predicate to match the path.+ -> Maybe (Path Abs Dir) -- ^ Do not ascend above this directory.+ -> m (Maybe (Path Abs t)) -- ^ Absolute path.+findPathUp pathType dir p upperBound = do+ entries <- listDir dir+ case find p (pathType entries) of+ Just path -> return (Just path)+ Nothing+ | Just dir == upperBound -> return Nothing+ | parent dir == dir -> return Nothing+ | otherwise -> findPathUp pathType (parent dir) p upperBound
test/pure/Spec.hs view
@@ -1,10 +1,10 @@-module Main - ( main - ) where - -import Test.Framework (defaultMain, testGroup) -import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test) - -main :: IO () -main = defaultMain [] +module Main+ ( main+ ) where++import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)++main :: IO ()+main = defaultMain []
test/self-formatting/Spec.hs view
@@ -1,17 +1,17 @@-module Main - ( main - ) where - -import Language.Haskell.Format.Utilities - -import Test.Framework (defaultMain, testGroup) -import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test) - -main :: IO () -main = - defaultMain - [ testGroup - "Check formatting of package sources" - (hUnitTestToTests $ hunitTest "hfmt.cabal") - ] +module Main+ ( main+ ) where++import Language.Haskell.Format.Utilities++import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)++main :: IO ()+main =+ defaultMain+ [ testGroup+ "Check formatting of package sources"+ (hUnitTestToTests $ hunitTest "hfmt.cabal")+ ]