packages feed

hfmt 0.1.1 → 0.2.0

raw patch · 18 files changed

+620/−413 lines, 18 filesdep +conduit-combinatorsdep −pipesdep ~basedep ~haskell-src-extsdep ~hindent

Dependencies added: conduit-combinators

Dependencies removed: pipes

Dependency ranges changed: base, haskell-src-exts, hindent, hlint, stylish-haskell

Files

+ .stylish-haskell.yaml view
@@ -0,0 +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
app/Actions.hs view
@@ -3,51 +3,39 @@   ) where  import Language.Haskell.Format-import OptionsParser+import Language.Haskell.Format.Utilities+import Options import Types  import Control.Monad-import Data.Algorithm.Diff-import Data.Algorithm.DiffContext-import Data.Algorithm.DiffOutput-import Text.PrettyPrint -act :: Options -> ReformatResult -> IO ReformatResult-act options r@(InvalidReformat input errorString) = do-  putStrLn ("Error reformatting " ++ show input ++ ": " ++ errorString)-  return r-act options r@(Reformat input source result) = act' (optAction options)+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 = undefined-    act' PrintFilePaths = when wasReformatted (print input) >> return r+      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 (Reformat input (reformattedSource result) result)-    wasReformatted = sourceChangedOrHasSuggestions source result--sourceChangedOrHasSuggestions :: HaskellSource -> Reformatted -> Bool-sourceChangedOrHasSuggestions source reformatted =-  not (null (suggestions reformatted)) ||-  source /= reformattedSource reformatted+      when wasReformatted' (writeSource input (reformattedSource result))+      return (Formatted input (reformattedSource result) result)+    wasReformatted' = wasReformatted source result -printDiff :: InputFile -> HaskellSource -> Reformatted -> IO ()-printDiff (InputFilePath path) source reformatted = do+printDiff :: SourceFile -> HaskellSource -> Reformatted -> IO ()+printDiff (SourceFilePath path) source reformatted = do   putStrLn (path ++ ":")   mapM_ (putStr . show) (suggestions reformatted)   putStr (showDiff source (reformattedSource reformatted))-printDiff InputFromStdIn source reformatted = do+printDiff StdinSource source reformatted = do   mapM_ (putStr . show) (suggestions reformatted)   putStr (showDiff source (reformattedSource reformatted)) -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+printSource :: HaskellSource -> IO ()+printSource (HaskellSource _ source) = putStr source -writeSource :: InputFile -> HaskellSource -> IO ()-writeSource (InputFilePath path) (HaskellSource source) = writeFile path source-writeSource InputFromStdIn (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
@@ -0,0 +1,44 @@+module ExitCode+  ( exitCode+  , helpDoc+  , operationalFailureCode+  ) 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 -> Bool -> ExitCode+exitCode action formattedCodeDiffers =+  if formattedCodeDiffers && failOnDifferences+    then ExitFailure formattedCodeDiffersFailureCode+    else ExitSuccess+  where+    failOnDifferences = action == PrintDiffs++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++-- | Formatted code differs from existing source code+formattedCodeDiffersFailureCode :: Int+formattedCodeDiffersFailureCode = 4
app/Main.hs view
@@ -1,73 +1,81 @@+{-# LANGUAGE Rank2Types #-}+ module Main   ( main   ) where -import           Actions-import           Language.Haskell.Format-import           Language.Haskell.Format.Utilities  hiding (wasReformatted)-import           Language.Haskell.Source.Enumerator-import           OptionsParser                      as Options-import           Types+import Actions+import ExitCode+import Language.Haskell.Format+import Language.Haskell.Format.Utilities+import Language.Haskell.Source.Enumerator+import Options+import Types -import           Control.Applicative-import           Control.Monad-import           Data.List-import           Data.Maybe-import           Data.Monoid-import           Options.Applicative.Extra          as OptApp-import           Pipes-import qualified Pipes.Prelude                      as P-import           System.Exit+import Conduit+import Options.Applicative.Extra          as OptApp+import System.Directory+import System.Exit  main :: IO () main = do   options <- execParser Options.parser-  formatter <- defaultFormatter-  reformatNeeded <- runFormatter formatter options-  if reformatNeeded-    then exitFailure-    else exitSuccess+  formattedCodeDiffers <- run options+  exitWith $ exitCode (optAction options) formattedCodeDiffers -runFormatter :: Formatter -> Options -> IO Bool-runFormatter formatter options =-  anyStrict-    sourceChangedOrHasSuggestions-    (inputFiles >-> P.map reformat >-> P.mapM writeOutput)+run :: Options -> IO Bool+run options =+  runConduit $+  sources .| mapMC readSource .| mapMC formatSource .| handleFormatErrors .|+  mapMC action .|+  summarize   where-    anyStrict :: Monad m => (a -> Bool) -> Producer a m () -> m Bool-    anyStrict f = P.fold (\acc x -> acc || f x) False id-    inputFiles = readInputFiles options-    reformat = applyFormatter formatter-    writeOutput = Actions.act options--readInputFiles :: Options -> Producer InputFileWithSource IO ()-readInputFiles options =-  determineInputFilePaths (optPaths options) >-> P.mapM readInputFile+    paths = do+      let explicitPaths = optPaths options+      if null explicitPaths+        then do+          currentPath <- getCurrentDirectory+          return [currentPath]+        else return explicitPaths+    sources :: Source IO SourceFile+    sources = lift paths >>= mapM_ sourcesFromPath+    formatSource source = do+      formatter <- defaultFormatter+      return $ applyFormatter formatter source+    handleFormatErrors = concatMapMC handleFormatError+    action = Actions.act options+    summarize =+      anyC' (\(Formatted _ source result) -> wasReformatted source result) -determineInputFilePaths :: [FilePath] -> Producer InputFile IO ()-determineInputFilePaths [] = enumeratePath "." >-> P.map InputFilePath-determineInputFilePaths ["-"] = yield InputFromStdIn-determineInputFilePaths paths =-  for (each paths) enumeratePath >-> P.map InputFilePath+sourcesFromPath :: FilePath -> Source IO SourceFile+sourcesFromPath "-"  = yield StdinSource+sourcesFromPath path = enumeratePath path .| mapC SourceFilePath -readInputFile :: InputFile -> IO InputFileWithSource-readInputFile (InputFilePath path) =-  InputFileWithSource (InputFilePath path) <$> readSource path-readInputFile InputFromStdIn = InputFileWithSource InputFromStdIn <$> readStdin+readSource :: SourceFile -> IO SourceFileWithContents+readSource s@(SourceFilePath path) =+  SourceFileWithContents s . HaskellSource path <$> readFile path+readSource s@StdinSource =+  SourceFileWithContents s . HaskellSource "stdin" <$> getContents -applyFormatter :: Formatter -> InputFileWithSource -> ReformatResult-applyFormatter (Formatter format) (InputFileWithSource input source) =-  case format source of-    Left error        -> InvalidReformat input error-    Right reformatted -> Reformat input source reformatted+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) -readSource :: HaskellSourceFilePath -> IO HaskellSource-readSource path = HaskellSource <$> readFile path+handleFormatError :: FormatResult -> IO (Maybe Formatted)+handleFormatError (Left err)        = printFormatError err >> return Nothing+handleFormatError (Right formatted) = return $ Just formatted -readStdin :: IO HaskellSource-readStdin = HaskellSource <$> getContents+printFormatError :: FormatError -> IO ()+printFormatError (FormatError input errorString) =+  putStrLn ("Error reformatting " ++ show input ++ ": " ++ errorString) -sourceChangedOrHasSuggestions :: ReformatResult -> Bool-sourceChangedOrHasSuggestions (Reformat input source reformatted) =-  not (null (suggestions reformatted)) ||-  source /= reformattedSource reformatted+-- | Check that at least one value in the stream returns True.+--+-- Does not shortcut, entire stream is always consumed+anyC' :: Monad m => (a -> Bool) -> Consumer a m Bool+anyC' f = do+  result <- anyC f -- Check for at least one value, may shortcut+  sinkNull -- consume any remaining input skipped by a shortcut+  return result
+ app/Options.hs view
@@ -0,0 +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
− app/OptionsParser.hs 
@@ -1,85 +0,0 @@-module OptionsParser-  ( Options-  , optAction-  , optPaths-  , parser-  ) where--import Types--import Control.Applicative-import Data.List-import Data.Monoid-import Options.Applicative.Builder-import Options.Applicative.Common-import Options.Applicative.Extra-import Text.PrettyPrint.ANSI.Leijen hiding (empty, (<$>), (<>))--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' <>-     help "If a file's formatting is different, print its source.") <*>-  switch-    (long "print-paths" <> short 'l' <>-     help "If a file's formatting is different, print its path.") <*>-  switch-    (long "write-sources" <> short 'w' <>-     help "If a file's formatting is different, overwrite it.") <*>-  many pathOption-  where-    pathOption = strArgument (metavar "PATH" <> pathOptionHelp)-    pathOptionHelp =-      helpDoc $-      Just $-      paragraph "Explicit paths to process." <> hardline <>-      unorderdedList-        " - "-        [ paragraph "A single '-' will process standard input."-        , paragraph "Files will be processed directly."-        , paragraph-            "Directories will be recursively searched for source files to process."-        , paragraph-            ".cabal files will be parsed and all specified source directories and files processed."-        , paragraph-            "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."-        ]--paragraph :: String -> Doc-paragraph = mconcat . intersperse softline . map text . words--unorderdedList :: String -> [Doc] -> Doc-unorderdedList prefix =-  encloseSep (text prefix) mempty (text prefix) . map (hang 0)--optionParserInfo :: ParserInfo Options-optionParserInfo =-  info-    (helper <*> optionParser)-    (fullDesc <> header "hfmt - format Haskell programs" <>-     progDesc-       "Operates on Haskell source files, reformatting them by applying suggestions from HLint, hindent, and stylish-haskell. Inspired by the gofmt utility.")--parser :: ParserInfo Options-parser = optionParserInfo
app/Types.hs view
@@ -1,39 +1,41 @@ module Types   ( Action(..)-  , InputFile(..)-  , InputFileWithSource(..)-  , ErrorString-  , ReformatResult(..)-  , HaskellSourceFilePath+  , FormatResult+  , FormatError(..)+  , Formatted(..)   , HaskellSource(..)+  , SourceFile(..)+  , SourceFileWithContents(..)   ) where  import Language.Haskell.Format-import Language.Haskell.Source.Enumerator (HaskellSourceFilePath)  data Action   = PrintDiffs   | PrintSources   | PrintFilePaths   | WriteSources+  deriving (Eq) -data InputFile-  = InputFilePath HaskellSourceFilePath-  | InputFromStdIn+data SourceFile+  = SourceFilePath FilePath+  | StdinSource -instance Show InputFile where-  show (InputFilePath path) = path-  show InputFromStdIn       = "-"+instance Show SourceFile where+  show (SourceFilePath path) = path+  show StdinSource           = "-" -data InputFileWithSource =-  InputFileWithSource InputFile-                      HaskellSource+data SourceFileWithContents =+  SourceFileWithContents SourceFile+                         HaskellSource -type ErrorString = String+type FormatResult = Either FormatError Formatted -data ReformatResult-  = InvalidReformat InputFile-                    ErrorString-  | Reformat InputFile-             HaskellSource-             Reformatted+data FormatError =+  FormatError SourceFile+              String++data Formatted =+  Formatted SourceFile+            HaskellSource+            Reformatted
hfmt.cabal view
@@ -1,5 +1,5 @@ name:                hfmt-version:             0.1.1+version:             0.2.0 synopsis:            Haskell source code formatter description:         Inspired by gofmt. Built using hlint, hindent, and stylish-haskell. license:             MIT@@ -11,9 +11,9 @@ bug-reports:         http://github.com/danstiner/hfmt/issues category:            Language build-type:          Simple-extra-source-files:  README.md+extra-source-files:  README.md, .stylish-haskell.yaml cabal-version:       >=1.9.2-tested-with:         GHC >= 7.10+tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.3  library   Hs-Source-Dirs:    src@@ -21,26 +21,28 @@                      , Language.Haskell.Format.Utilities                      , Language.Haskell.Source.Enumerator   Other-Modules:     Language.Haskell.Format.Internal-                     , Language.Haskell.Format.Definitions                      , 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-combinators+                     , Diff                      , directory                      , exceptions                      , filepath-                     , haskell-src-exts-                     , hindent >= 5.2.3-                     , hlint >= 1.9+                     , haskell-src-exts < 1.20+                     , hindent == 5.*+                     , hlint == 2.*                      , HUnit                      , path                      , path-io-                     , pipes-                     , stylish-haskell >= 0.7+                     , pretty+                     , stylish-haskell == 0.8.*                      , text                      , transformers                      , yaml@@ -49,16 +51,16 @@   Hs-Source-Dirs:    app   Main-Is:           Main.hs   Other-Modules:     Actions-                   , OptionsParser+                   , ExitCode+                   , Options                    , Types   GHC-Options:       -Wall-  Build-Depends:     base == 4.*+  Build-Depends:     base >= 4.8 && < 5+                   , conduit-combinators+                   , directory                    , hfmt                    , ansi-wl-pprint-                   , Diff                    , optparse-applicative-                   , pipes-                   , pretty  test-suite self-formatting-test   Type:              exitcode-stdio-1.0
src/Language/Haskell/Format.hs view
@@ -12,13 +12,10 @@   , Reformatted(..)   ) where -import           Language.Haskell.Format.Definitions-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           Control.Applicative-import           Data.Maybe+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
− src/Language/Haskell/Format/Definitions.hs 
@@ -1,46 +0,0 @@-module Language.Haskell.Format.Definitions-  ( HaskellSource(..)-  , Reformatted(..)-  , Formatter(..)-  , Suggestion(..)-  ) where--import Control.Applicative-import Control.Monad-import Data.Monoid--type ErrorString = String--newtype HaskellSource =-  HaskellSource 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/HIndent.hs view
@@ -4,24 +4,20 @@   , defaultFormatter   ) where -import           Control.Applicative import           Data.ByteString.Builder-import           Data.ByteString.Lazy                as L-import           Data.Maybe-import qualified Data.Text                           as Text-import           Data.Text.Encoding                  as Encoding-import           Data.Text.Lazy                      as TL-import           Data.Text.Lazy.Builder-import qualified Data.Yaml                           as Y+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           Language.Haskell.Exts.Extension  (Extension) import           Path-import qualified Path.Find                           as Path-import qualified Path.IO                             as Path+import qualified Path.Find                        as Path+import qualified Path.IO                          as Path -import           Language.Haskell.Format.Definitions import           Language.Haskell.Format.Internal+import           Language.Haskell.Format.Types  data Settings =   Settings Config@@ -57,10 +53,10 @@ formatter = mkFormatter . hindent  hindent :: Settings -> HaskellSource -> Either String HaskellSource-hindent (Settings config extensions) (HaskellSource source) =-  toHaskellSource <$> reformat config extensions Nothing sourceText+hindent (Settings config extensions) (HaskellSource filepath source) =+  HaskellSource filepath . unpackBuilder <$>+  reformat config extensions Nothing sourceText   where     sourceText = Encoding.encodeUtf8 . Text.pack $ source-    toHaskellSource =-      HaskellSource .+    unpackBuilder =       Text.unpack . Encoding.decodeUtf8 . L.toStrict . toLazyByteString
src/Language/Haskell/Format/HLint.hs view
@@ -3,16 +3,14 @@   , suggester   ) where -import           Language.Haskell.Format.Definitions import           Language.Haskell.Format.Internal+import           Language.Haskell.Format.Types -import           Control.Applicative-import           Language.Haskell.HLint3             (Classify, Hint,-                                                      ParseError (..),-                                                      ParseFlags, applyHints,-                                                      parseModuleEx)-import qualified Language.Haskell.HLint3             as HLint3-import           System.IO.Unsafe                    (unsafePerformIO)+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@@ -21,12 +19,11 @@      (ParseFlags, [Classify], Hint)   -> HaskellSource   -> Either String [Suggestion]-hlint (flags, classify, hint) (HaskellSource source) =+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-    filepath = ""     ideas m = applyHints classify hint [m]  autoSettings :: IO (ParseFlags, [Classify], Hint)
src/Language/Haskell/Format/Internal.hs view
@@ -3,9 +3,7 @@   , mkSuggester   ) where -import Language.Haskell.Format.Definitions--import Control.Applicative+import Language.Haskell.Format.Types  mkFormatter :: (HaskellSource -> Either String HaskellSource) -> Formatter mkFormatter f = Formatter (fmap (\source -> Reformatted source []) . f)
src/Language/Haskell/Format/Stylish.hs view
@@ -3,26 +3,29 @@   , formatter   ) where -import Control.Applicative-import Language.Haskell.Stylish            as Stylish+import Language.Haskell.Stylish         as Stylish -import Language.Haskell.Format.Definitions import Language.Haskell.Format.Internal+import Language.Haskell.Format.Types  newtype Settings =   Settings Stylish.Config  autoSettings :: IO Settings-autoSettings =-  Settings <$> Stylish.loadConfig (Stylish.makeVerbose False) Nothing+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 source) =-  HaskellSource . unlines <$>-  Stylish.runSteps extensions Nothing steps sourceLines+stylish (Settings config) (HaskellSource filepath source) =+  HaskellSource filepath . unlines <$>+  Stylish.runSteps extensions (Just filepath) steps sourceLines   where     sourceLines = lines source     extensions = Stylish.configLanguageExtensions config
+ src/Language/Haskell/Format/Types.hs view
@@ -0,0 +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)
src/Language/Haskell/Format/Utilities.hs view
@@ -1,69 +1,105 @@ module Language.Haskell.Format.Utilities-  ( wasReformatted+  ( defaultFormatter   , hunitTest-  , defaultFormatter+  , showDiff+  , wasReformatted   ) where -import           Language.Haskell.Format-import           Language.Haskell.Format.Definitions-import           Language.Haskell.Source.Enumerator+import System.IO.Unsafe -import           Control.Applicative-import           Control.Monad-import           Data.Monoid-import           Pipes-import qualified Pipes.Prelude                       as P-import           Test.HUnit+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 ErrorString+  = 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 $ makeTestCase filepath+hunitTest filepath = TestLabel filepath . unsafePerformIO . testPath $ filepath -makeTestCase :: FilePath -> Test-makeTestCase filepath =-  TestCase $ do-    formatter <- defaultFormatter-    runEffect $ check formatter filepath >-> assertResults+testPath :: FilePath -> IO Test+testPath filepath = do+  formatter <- defaultFormatter+  TestList <$>+    runConduit (check formatter filepath .| mapC makeTestCase .| sinkList) -assertResults :: Consumer CheckResult IO ()-assertResults =-  forever $ do-    result <- await-    case result of-      (InvalidCheckResult errorString) ->-        lift $ assertFailure ("Error: " ++ errorString)-      (CheckResult source reformatted) ->-        when (wasReformatted source reformatted) $-        lift $-        assertFailure-          ("Incorrect formatting: " ++ concatMap show (suggestions reformatted))+makeTestCase :: CheckResult -> Test+makeTestCase result =+  TestLabel (checkResultPath result) . TestCase $ assertCheckResult result -check :: Formatter -> FilePath -> Producer CheckResult IO ()-check formatter path =-  enumeratePath path >-> P.mapM readSource >-> P.map (checkFormatting formatter)+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 -readSource :: HaskellSourceFilePath -> IO HaskellSource-readSource path = HaskellSource <$> readFile path+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 format) source =-  case format source of-    Left error        -> InvalidCheckResult error+checkFormatting (Formatter doFormat) source =+  case doFormat source of+    Left err          -> InvalidCheckResult source err     Right reformatted -> CheckResult source reformatted -fix :: Formatter -> FilePath -> IO ()-fix = undefined- defaultFormatter :: IO Formatter defaultFormatter = mconcat <$> (autoSettings >>= formatters)  wasReformatted :: HaskellSource -> Reformatted -> Bool wasReformatted source reformatted =-  not (null (suggestions reformatted)) ||-  source /= reformattedSource 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,72 +1,49 @@ module Language.Haskell.Source.Enumerator   ( enumeratePath-  , HaskellSourceFilePath   ) 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           Pipes import           System.Directory import           System.FilePath -type HaskellSourceFilePath = FilePath--enumeratePath :: FilePath -> Producer HaskellSourceFilePath IO ()-enumeratePath = filePath--filePath :: FilePath -> Producer HaskellSourceFilePath IO ()-filePath path = do-  isCabal <- lift $ isCabalFile path-  if isCabal-    then package' path-    else directoryOrFile path--simpleFilePath :: FilePath -> Producer HaskellSourceFilePath IO ()-simpleFilePath path = do-  isHaskellSource <- lift $ isHaskellSourceFile path-  when isHaskellSource $ yield path--simpleDirectory :: FilePath -> Producer HaskellSourceFilePath IO ()-simpleDirectory path = do-  contents <- lift $ getDirectoryContentsFullPaths path-  mapM_ simpleFileOrDirectory contents+enumeratePath :: FilePath -> Source IO FilePath+enumeratePath path = enumPath path .| mapC normalise -simpleFileOrDirectory :: FilePath -> Producer HaskellSourceFilePath IO ()-simpleFileOrDirectory filepath = do-  dir <- lift $ doesDirectoryExist filepath-  if dir-    then simpleDirectory filepath-    else simpleFilePath filepath+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 () -package' :: FilePath -> Producer HaskellSourceFilePath IO ()-package' path = readPackage path >>= expandPaths+enumPackage :: FilePath -> Source IO FilePath+enumPackage cabalFile = readPackage cabalFile >>= expandPaths   where     readPackage = lift . readPackageDescription Verbosity.silent-    expandPaths = mapM_ (simpleFileOrDirectory . mkFull) . sourcePaths-    dir = dropFileName path-    mkFull = (dir </>)+    expandPaths = mapM_ (enumPath . mkFull) . sourcePaths+    packageDir = dropFileName cabalFile+    mkFull = (packageDir </>) -directory :: FilePath -> Producer HaskellSourceFilePath IO ()-directory path = do-  contents <- lift $ getDirectoryContentsFullPaths path+enumDirectory :: FilePath -> Source IO FilePath+enumDirectory path = do+  contents <- lift $ getDirectoryContentFullPaths path   cabalFiles <- lift $ filterM isCabalFile contents   if null cabalFiles-    then mapM_ directoryOrFile contents-    else mapM_ package' cabalFiles--directoryOrFile :: FilePath -> Producer HaskellSourceFilePath IO ()-directoryOrFile path = do-  isFile <- lift $ doesFileExist path-  if isFile-    then simpleFilePath path-    else directory path+    then mapM_ enumPath contents+    else mapM_ enumPackage cabalFiles -getDirectoryContentsFullPaths :: FilePath -> IO [FilePath]-getDirectoryContentsFullPaths path =+getDirectoryContentFullPaths :: FilePath -> IO [FilePath]+getDirectoryContentFullPaths path =   mkFull . notHidden . notMeta <$> getDirectoryContents path   where     mkFull = map (path </>)@@ -74,17 +51,14 @@     notMeta = (\\ [".", ".."])  isCabalFile :: FilePath -> IO Bool-isCabalFile path = (hasCabalExtension &&) <$> isFile-  where-    isFile = doesFileExist path-    hasCabalExtension = ".cabal" `isSuffixOf` path+isCabalFile path = return (hasCabalExtension path) <&&> doesFileExist path -isHaskellSourceFile :: FilePath -> IO Bool-isHaskellSourceFile path = (hasHaskellExtension &&) <$> isFile-  where-    isFile = doesFileExist path-    hasHaskellExtension = ".hs" `isSuffixOf` path || ".lhs" `isSuffixOf` 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@@ -97,3 +71,8 @@       , concatMap (hsSourceDirs . benchmarkBuildInfo . condTreeData . snd) .         condBenchmarks       ]++(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool+(<&&>) = liftA2 (&&)++infixr 3 <&&> -- same as (&&)
src/Path/Find.hs view
@@ -6,14 +6,11 @@   ( findFileUp   ) where -import Control.Exception      (evaluate)-import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class import Data.List import Path-import Path.IO                hiding (findFiles)-import System.IO.Error        (isPermissionError)+import Path.IO  -- | Find the location of a file matching the given predicate. findFileUp ::@@ -23,15 +20,6 @@   -> 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 directory matching the given predicate.-findDirUp ::-     (MonadIO m, MonadThrow m)-  => Path Abs Dir -- ^ Start here.-  -> (Path Abs Dir -> Bool) -- ^ Predicate to match the directory.-  -> Maybe (Path Abs Dir) -- ^ Do not ascend above this directory.-  -> m (Maybe (Path Abs Dir)) -- ^ Absolute directory path.-findDirUp = findPathUp fst  -- | Find the location of a path matching the given predicate. findPathUp ::