hfmt 0.2.1 → 0.2.2
raw patch · 21 files changed
+1125/−1125 lines, 21 filesdep ~haskell-src-extsdep ~stylish-haskellsetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: haskell-src-exts, stylish-haskell
API changes (from Hackage documentation)
- Language.Haskell.Source.Enumerator: enumeratePath :: FilePath -> Source IO FilePath
+ Language.Haskell.Source.Enumerator: enumeratePath :: FilePath -> ConduitT () FilePath IO ()
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 +60/−60
- hfmt.cabal +89/−89
- src/Language/Haskell/Format.hs +39/−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 +46/−46
- src/Language/Haskell/Format/Utilities.hs +105/−105
- src/Language/Haskell/Source/Enumerator.hs +78/−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 -> Source IO SourceFile-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 -> Source IO SourceFile-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.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
app/Types.hs view
@@ -1,60 +1,60 @@-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 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
hfmt.cabal view
@@ -1,89 +1,89 @@-name: hfmt-version: 0.2.1-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 == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.3--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.8.*- , 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.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
src/Language/Haskell/Format.hs view
@@ -1,39 +1,39 @@-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 + +formatters :: Settings -> IO [Formatter] +formatters s = sequence [hlint s, hindent s, stylish s] + +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.autoSettings + +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 (Just 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,46 @@-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.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)
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 -> Source IO CheckResult-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,78 @@-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 -> Source IO FilePath-enumeratePath path = enumPath path .| mapC normalise--enumPath :: FilePath -> Source IO FilePath-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 -> Source IO FilePath-enumPackage cabalFile = readPackage cabalFile >>= expandPaths- where- readPackage = lift . readPackageDescription Verbosity.silent- expandPaths = mapM_ (enumPath . mkFull) . sourcePaths- packageDir = dropFileName cabalFile- mkFull = (packageDir </>)--enumDirectory :: FilePath -> Source IO FilePath-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 (&&)+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 (&&)
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") + ]