hspretty (empty) → 0.1.0.0
raw patch · 11 files changed
+959/−0 lines, 11 filesdep +ansi-terminaldep +basedep +bytestring
Dependencies added: ansi-terminal, base, bytestring, directory, doctest, hspretty, optparse-applicative, ormolu, path, path-io, process, streamly, text, text-short, unliftio, void
Files
- CHANGELOG.md +6/−0
- app/Main.hs +6/−0
- hspretty.cabal +73/−0
- src/CLI.hs +159/−0
- src/Formatter.hs +302/−0
- src/Formatters/CabalFmt.hs +87/−0
- src/Formatters/Ormolu.hs +77/−0
- src/Log.hs +88/−0
- src/PathFilter.hs +122/−0
- src/RunMode.hs +13/−0
- test/Test.hs +26/−0
+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Revision history for hspretty++## 0.1.0.0 -- 2021-05-16++* First version. Created as a Haskell package from this Gist:+ https://gist.github.com/lancelet/9a9d5e207d36be20e0e1f16fbe51bb7d
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import qualified CLI (run)++main :: IO ()+main = CLI.run
+ hspretty.cabal view
@@ -0,0 +1,73 @@+cabal-version: 2.4+name: hspretty+version: 0.1.0.0+synopsis: My opinionated Haskell project formatter.+description:+ This is a formatter for Haskell projects (for example, for *.cabal files and+ *.hs files) that can perform both in-place formatting and formatting checks.+ In the background, it uses Ormolu and cabal-fmt. Please make sure that+ cabal-fmt is installed separately before running it, since it invokes+ cabal-fmt as a command-line utility.+ .+ It is licensed under the BSD-3-Clause license to match Ormolu and cabal-fmt.++license: BSD-3-Clause+author: Jonathan Merritt+maintainer: j.s.merritt@gmail.com+copyright: Copyright (C) Jonathan Merritt 2021+category: Tools+extra-source-files: CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/lancelet/hspretty.git++common base+ default-language: Haskell2010+ build-depends: base ^>=4.14.1.0++common ghc-options+ ghc-options:+ -Wall -Wcompat -Wincomplete-record-updates+ -Wincomplete-uni-patterns -Wredundant-constraints++library+ import: base, ghc-options+ hs-source-dirs: src+ exposed-modules:+ CLI+ Formatter+ Formatters.CabalFmt+ Formatters.Ormolu+ Log+ PathFilter+ RunMode++ build-depends:+ , ansi-terminal ^>=0.11+ , bytestring ^>=0.10.12.0+ , directory ^>=1.3.6.0+ , optparse-applicative ^>=0.16.1.0+ , ormolu ^>=0.1.4.1+ , path ^>=0.8.0+ , path-io ^>=1.6.2+ , process ^>=1.6.11.0+ , streamly ^>=0.7.3+ , text ^>=1.2.4.1+ , text-short ^>=0.1.3+ , unliftio ^>=0.2.16+ , void ^>=0.7.3++test-suite hspretty-test+ import: base, ghc-options+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Test.hs+ build-depends: doctest ^>=0.18.1++executable hspretty+ import: base, ghc-options+ main-is: Main.hs+ hs-source-dirs: app+ ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T"+ build-depends: hspretty
+ src/CLI.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Description : Command-line interface.+--+-- This module performs the command-line interface for the formatter, and+-- plumbs formatting actions through a streaming interface.+module CLI where++import Data.Function ((&))+import qualified Data.Text.Short as ShortText+import Formatter (Formatter, runFormatIO)+import qualified Formatter+import qualified Formatters.CabalFmt (formatter)+import qualified Formatters.Ormolu (formatter)+import qualified GHC.Conc+import qualified Log+import Options.Applicative (Parser)+import qualified Options.Applicative as OA+import Path (Abs, Dir, File, Path)+import qualified Path+import qualified Path.IO+import PathFilter (PathFilter)+import qualified PathFilter+import RunMode (RunMode)+import qualified RunMode+import Streamly (AsyncT, asyncly, maxThreads, serially)+import qualified Streamly.Prelude as S+import qualified System.Exit++-- | Main entry point.+run :: IO ()+run = do+ -- parse command-line arguments+ args <- parseArgs++ -- set the default logger+ let lg = Log.defaultLog++ -- fetch number of capabilities; to decide the number of threads+ numCap <- GHC.Conc.getNumCapabilities+ let nThreads = numCap + 2++ -- fetch the current directory to use as the parent directory+ dir <- Path.IO.getCurrentDir++ -- tell the user what we're doing+ let txtMode =+ case runMode args of+ RunMode.Format -> "file formatting"+ RunMode.CheckOnly -> "checking only"+ Log.info lg "# Formatter Utility"+ Log.info lg $ "Mode : " <> txtMode+ Log.info lg $+ "Threadpool size : "+ <> (ShortText.pack . show $ nThreads)+ Log.info lg $+ "Parent directory : "+ <> (ShortText.pack . Path.fromAbsDir $ dir)++ -- streamly action+ changed :: [Bool] <-+ S.toList $+ S.map (Formatter.isUnchanged . snd) $+ serially+ ( asyncly . maxThreads nThreads $+ ( listDirRecursive dir+ & S.map (fromJustUnsafe . Path.stripProperPrefix dir)+ & S.filter+ ( PathFilter.toBool+ . PathFilter.unPathFilter pathFilter+ )+ & S.mapM+ ( \relFile -> do+ result <-+ Formatter.runFormatIO+ (runMode args)+ formatter+ dir+ relFile+ pure (relFile, result)+ )+ )+ )+ & S.trace (uncurry (Log.report lg))+ let noChange = and changed++ -- report on the overall outcome if necessary+ case runMode args of+ RunMode.Format -> System.Exit.exitSuccess+ RunMode.CheckOnly -> do+ if noChange+ then do+ Log.info lg "Done: All files passed formatting checks."+ System.Exit.exitSuccess+ else do+ Log.info lg "Done: File(s) failed formatting checks."+ System.Exit.exitFailure++-- | Default path filter.+pathFilter :: PathFilter+pathFilter =+ PathFilter.pfNoHidden+ <> PathFilter.pfNoDistNewstyle++-- | Default formatter.+formatter :: Formatter+formatter =+ Formatters.Ormolu.formatter+ <> Formatters.CabalFmt.formatter++-- | fromJust.+fromJustUnsafe :: Maybe a -> a+fromJustUnsafe (Just x) = x+fromJustUnsafe Nothing = error "fromJustUnsafe: not Just!"++-- | List a directory recursively for streaming.+listDirRecursive :: Path Abs Dir -> AsyncT IO (Path Abs File)+listDirRecursive dir = do+ (subdirs, files) <- Path.IO.listDir dir+ S.fromList files <> foldMap listDirRecursive subdirs++-- | Command-line arguments.+newtype Args = Args+ { -- Run mode.+ runMode :: RunMode+ }++-- | Parse command-line arguments.+parseArgs :: IO Args+parseArgs = OA.execParser opts+ where+ opts =+ OA.info+ (parser OA.<**> OA.helper)+ ( OA.fullDesc+ <> OA.progDesc "Formatting Utility"+ <> OA.header "format - formatting stuff for Haskell projects"+ )++-- | Parser for command-line arguments.+parser :: Parser Args+parser =+ Args+ <$> OA.subparser+ ( OA.command+ "check"+ ( OA.info+ (pure RunMode.CheckOnly)+ (OA.progDesc "Only check file formatting (do not over-write)")+ )+ <> OA.command+ "format"+ ( OA.info+ (pure RunMode.Format)+ (OA.progDesc "Format files (over-write if required)")+ )+ )
+ src/Formatter.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Description : Formatter types and operations.+--+-- 'Formatter' is a (potential) formatter for a file. It contains a method,+-- 'runFormat', which takes a relative path to a file and, by inspecting the+-- path alone, must decide whether to format the file or not. To specify if the+-- file will be formatted by that formatter, it returns a 'FormattingDirective'.+--+-- If the 'FormattingDirective' is 'Format' then that constructor supplies a+-- function which can take the 'FileContent', and return a 'FormattingResult'.+-- In turn, the 'FormattingResult' specifies the result of formatting.+--+-- To implement a new 'Formatter', return a new 'Formatter' instance, which+-- inspects the file path and, if the file can be formatted by that 'Formatter',+-- return a 'Format' constructor containing the formatting operation.+--+-- All aspects of the 'Formatter' operation are pure or "effectively pure". If+-- 'IO' operations are required, they should be implemented in+-- 'System.IO.Unsafe.unsafePerformIO' as effectively-pure operations.+module Formatter+ ( -- * Types++ -- ** Formatting+ Formatter (..),+ FormattingDirective (..),+ FormattingResult (..),++ -- ** Miscellaneous+ FileContent (..),+ ErrorMessage (..),++ -- * IO Actions+ runFormatIO,+ readRelativeFile,+ readAbsoluteFile,+ writeRelativeFile,+ writeAbsoluteFile,++ -- * Functions++ -- ** Tests+ isUnchanged,++ -- ** Conversions+ fileContentToUtf8,+ utf8TextToFileContent,+ )+where++import Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import Data.Text (Text)+import qualified Data.Text.Encoding as Encoding+import Data.Text.Short (ShortText)+import qualified Data.Text.Short as ShortText+import Path (Abs, Dir, File, Path, Rel, (</>))+import qualified Path+import RunMode (RunMode)+import qualified RunMode+import UnliftIO (IOException)+import qualified UnliftIO++-- | Formatter.+newtype Formatter = Formatter+ { -- | Run the formatter.+ --+ -- This accepts a relative path to a file and returns a formatting+ -- directive for that file. This is a pure function: it can only inspect+ -- the name of the file, it should NOT try to perform any IO.+ runFormat :: Path Rel File -> FormattingDirective+ }++instance Semigroup Formatter where+ f1 <> f2 = Formatter $ \path ->+ case runFormat f1 path of+ DoNotFormat -> runFormat f2 path+ Format g1 ->+ case runFormat f2 path of+ DoNotFormat -> Format g1+ Format g2 -> Format (sequenceFmtFns g1 g2)+ where+ sequenceFmtFns ::+ (FileContent -> FormattingResult FileContent) ->+ (FileContent -> FormattingResult FileContent) ->+ (FileContent -> FormattingResult FileContent)+ sequenceFmtFns a b = \content ->+ case a content of+ NotFormatted -> b content+ Unchanged -> b content+ Changed content' -> b content'+ Error message -> Error message++instance Monoid Formatter where+ mempty = Formatter $ const DoNotFormat++-- | Formatting directive.+--+-- This indicates whether formatting can proceed or not.+data FormattingDirective+ = -- | Do not format the file any further.+ DoNotFormat+ | -- | Formatter, which, given the content of a file returns a formatting+ -- result.+ --+ -- This is a pure function. For some formatters, it may be necessary to run+ -- this action using 'System.IO.Unsafe.unsafePerformIO', but in that case,+ -- every effort should still be made to ensure it behaves as a pure+ -- function.+ Format (FileContent -> FormattingResult FileContent)++-- | Result of running a formatter.+--+-- The type parameter @a@ is the type of values returned when formatting has+-- changed.+data FormattingResult a+ = -- | The formatter decided not to format the file after inspecting it.+ NotFormatted+ | -- | Formatting completed successfully, without changes.+ Unchanged+ | -- | Formatting completed successfully, and there are new contents.+ Changed !a+ | -- | An error occurred while formatting.+ Error !ErrorMessage+ deriving (Eq)++-- | Return 'True' if a 'FormattingResult' indicates definitively that a file+-- was unchanged after successful processing.+isUnchanged :: FormattingResult a -> Bool+isUnchanged NotFormatted = True+isUnchanged Unchanged = True+isUnchanged _ = False++-- | Content of a file for formatting.+newtype FileContent = FileContent+ { unFileContent :: ByteString+ }+ deriving (Eq)++-- | Error message.+newtype ErrorMessage = ErrorMessage+ { unErrorMessage :: ShortText+ }+ deriving (Eq)++-- | Run a formatter in IO on a single file.+--+-- This operation checks if the formatter can run on the provided file. If it+-- can run then the file is loaded, and the formatter is run. If the run mode is+-- 'RunMode.Format' then the new formatted output is written to the file,+-- otherwise the file is left as-is.+runFormatIO ::+ -- | Run mode: either we're only checking, or we're also formatting.+ RunMode ->+ -- | Formatter to run.+ Formatter ->+ -- | Parent / project directory.+ Path Abs Dir ->+ -- | Path to the file (relative to the above parent directory).+ Path Rel File ->+ -- | Formatting result (without capturing the formatted output).+ IO (FormattingResult ())+runFormatIO runMode formatter parentDir file =+ case runFormat formatter file of+ DoNotFormat -> pure NotFormatted+ Format formatFn -> do+ readResult <- readRelativeFile parentDir file+ case readResult of+ Left message -> pure (Error message)+ Right content ->+ case formatFn content of+ NotFormatted -> pure NotFormatted+ Unchanged -> pure Unchanged+ Error message -> pure (Error message)+ Changed newContent -> do+ case runMode of+ RunMode.CheckOnly -> pure (Changed ())+ RunMode.Format -> do+ writeResult <- writeRelativeFile parentDir file newContent+ case writeResult of+ Left message -> pure (Error message)+ Right () -> pure (Changed ())++-- | Read a relative file into 'FileContent'.+--+-- If the action is unsuccessful then an 'ErrorMessage' is returned.+readRelativeFile ::+ -- | Path to the parent directory of the file.+ Path Abs Dir ->+ -- | Path of the file relative to the parent directory.+ Path Rel File ->+ -- | IO action containing the file content.+ IO (Either ErrorMessage FileContent)+readRelativeFile parentDir file = readAbsoluteFile (parentDir </> file)++-- | Read an absolute file into 'FileContent'.+--+-- If the action is unsuccessful then an 'ErrorMessage' is returned.+readAbsoluteFile ::+ -- | Path of the file to write.+ Path Abs File ->+ -- | IO action.+ IO (Either ErrorMessage FileContent)+readAbsoluteFile file = UnliftIO.catchIO action recover+ where+ path :: FilePath+ path = Path.toFilePath file++ action :: IO (Either ErrorMessage FileContent)+ action = Right . FileContent <$> ByteString.readFile path++ recover :: IOException -> IO (Either ErrorMessage FileContent)+ recover ioe = pure . Left . ErrorMessage $ message+ where+ message :: ShortText+ message =+ ShortText.pack $+ "hspretty: Error reading file \""+ <> path+ <> "\": "+ <> UnliftIO.displayException ioe++-- | Write a relative file from 'FileContent'.+--+-- If the action is unsuccessful then an 'ErrorMessage' is returned.+writeRelativeFile ::+ -- | Path of the parent directory of the file.+ Path Abs Dir ->+ -- | Path of the file relative to the parent directory.+ Path Rel File ->+ -- | Content of the file.+ FileContent ->+ -- | IO action that writes the file content.+ IO (Either ErrorMessage ())+writeRelativeFile parentDir file = writeAbsoluteFile (parentDir </> file)++-- | Write an absolute file from 'FileContent'+--+-- If the action is unsuccessful then an 'ErrorMessage' is returned.+writeAbsoluteFile ::+ -- | Absolute path of the file to write.+ Path Abs File ->+ -- | Content of the file.+ FileContent ->+ -- | IO action.+ IO (Either ErrorMessage ())+writeAbsoluteFile file content = UnliftIO.catchIO action recover+ where+ path :: FilePath+ path = Path.toFilePath file++ bs :: ByteString+ bs = unFileContent content++ action :: IO (Either ErrorMessage ())+ action = ByteString.writeFile path bs >> pure (Right ())++ recover :: IOException -> IO (Either ErrorMessage ())+ recover ioe = pure . Left . ErrorMessage $ message+ where+ message :: ShortText+ message =+ ShortText.pack $+ "hspretty: Error writing file \""+ <> path+ <> "\": "+ <> UnliftIO.displayException ioe++-- | Convert 'FileContent' from an underlying 'ByteString' to UTF-8.+--+-- If this operation fails with a unicode error, the underlying exception is+-- converted to an 'ErrorMessage'.+fileContentToUtf8 ::+ -- | Content to convert to UTF-8.+ FileContent ->+ -- | Path to the relative file, if known (used for error messages).+ Maybe (Path Rel File) ->+ -- | Either an error message, or the file read as UTF-8 text.+ Either ErrorMessage Text+fileContentToUtf8 fileContent maybeFile =+ case Encoding.decodeUtf8' (unFileContent fileContent) of+ Right txt -> Right txt+ Left unicodeException ->+ Left . ErrorMessage . ShortText.pack $+ case maybeFile of+ Nothing ->+ "hspretty: error decoding file contents as UTF-8: "+ <> UnliftIO.displayException unicodeException+ Just file ->+ "hspretty: error decoding file \""+ <> Path.fromRelFile file+ <> "\" as UTF-8: "+ <> UnliftIO.displayException unicodeException++-- | Encode 'Text' as 'FileContent' in UTF-8.+utf8TextToFileContent ::+ -- | Text to encode.+ Text ->+ -- | Text encoded as 'FileContent'.+ FileContent+utf8TextToFileContent = FileContent . Encoding.encodeUtf8
+ src/Formatters/CabalFmt.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Description : @cabal-fmt@ formatter.+--+-- Applies the @cabal-fmt@ formatter.+module Formatters.CabalFmt where++import qualified Data.Text.Short as ShortText+import Formatter (ErrorMessage, FileContent, Formatter, FormattingResult)+import qualified Formatter+import qualified Path+import qualified Path.IO+import PathFilter (PathFilter)+import qualified PathFilter+import qualified System.Directory+import qualified System.Exit+import qualified System.IO.Unsafe (unsafePerformIO)+import qualified System.Process+import qualified UnliftIO.IO++-- | cabal-fmt formatter.+formatter :: Formatter+formatter = Formatter.Formatter $ \path ->+ case PathFilter.unPathFilter pfCabal path of+ PathFilter.Reject -> Formatter.DoNotFormat+ PathFilter.Accept -> Formatter.Format formatAction++-- | Formatting action; defers to a 'System.IO.Unsafe.unsafePerformIO' action.+formatAction :: FileContent -> FormattingResult FileContent+formatAction content = System.IO.Unsafe.unsafePerformIO $ formatActionIO content++-- | Formatting action in 'IO'.+formatActionIO :: FileContent -> IO (FormattingResult FileContent)+formatActionIO content = do+ -- check that we have the cabal-fmt utility installed first+ cabalFmtCheck <- checkForCabalFmt+ case cabalFmtCheck of+ Left err -> pure . Formatter.Error $ err+ Right () -> do+ -- create a temp file for the cabal file that must be formatted and+ -- invoke cabal-fmt on that+ Path.IO.withSystemTempFile ".cabal" $+ \tempFile handle -> do+ UnliftIO.IO.hClose handle+ writeResult <- Formatter.writeAbsoluteFile tempFile content+ case writeResult of+ Left errorMessage -> pure . Formatter.Error $ errorMessage+ Right () -> do+ let cp =+ System.Process.proc+ "cabal-fmt"+ ["--inplace", Path.fromAbsFile tempFile]+ (exitCode, _, stderr) <-+ System.Process.readCreateProcessWithExitCode cp ""+ case exitCode of+ System.Exit.ExitFailure _ ->+ pure+ . Formatter.Error+ . Formatter.ErrorMessage+ . ShortText.pack+ $ stderr+ System.Exit.ExitSuccess -> do+ readResult <- Formatter.readAbsoluteFile tempFile+ case readResult of+ Left errorMessage -> pure . Formatter.Error $ errorMessage+ Right outContent ->+ pure $+ if outContent == content+ then Formatter.Unchanged+ else Formatter.Changed outContent++-- | Check for the @cabal-fmt@ executable, producing an error message if it is+-- not installed.+checkForCabalFmt :: IO (Either ErrorMessage ())+checkForCabalFmt = do+ exe <- System.Directory.findExecutable "cabal-fmt"+ case exe of+ Nothing ->+ pure . Left . Formatter.ErrorMessage $+ "Could not find executable \"cabal-fmt\"; please make sure it is "+ <> "available on the path."+ Just _ -> pure . Right $ ()++-- | A 'PathFilter' for @.cabal@ files.+pfCabal :: PathFilter+pfCabal = PathFilter.pfExtension ".cabal"
+ src/Formatters/Ormolu.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Description : Ormolu formatter.+--+-- Applies the Ormolu formatter.+module Formatters.Ormolu (formatter) where++import qualified Data.Text as Text+import qualified Data.Text.Short as ShortText+import Formatter (FileContent, Formatter, FormattingResult)+import qualified Formatter+import qualified Ormolu+import Path (File, Path, Rel)+import qualified Path+import PathFilter (PathFilter)+import qualified PathFilter+import qualified System.IO.Unsafe (unsafePerformIO)+import qualified UnliftIO++-- | Ormolu formatter.+formatter :: Formatter+formatter = Formatter.Formatter $ \path ->+ case PathFilter.unPathFilter pfHs path of+ PathFilter.Reject -> Formatter.DoNotFormat+ PathFilter.Accept ->+ Formatter.Format $ formatAction Ormolu.defaultConfig path++-- | Formatting action; defers to a 'System.IO.Unsafe.unsafePerformIO' action.+formatAction ::+ Ormolu.Config Ormolu.RegionIndices ->+ Path Rel File ->+ FileContent ->+ FormattingResult FileContent+formatAction config filePathForMessages content =+ System.IO.Unsafe.unsafePerformIO $+ formatActionIO config filePathForMessages content++-- | Formatting action in 'IO'.+formatActionIO ::+ Ormolu.Config Ormolu.RegionIndices ->+ Path Rel File ->+ FileContent ->+ IO (FormattingResult FileContent)+formatActionIO config filePathForMessages content = do+ case Formatter.fileContentToUtf8 content (Just filePathForMessages) of+ Left errorMessage -> pure $ Formatter.Error errorMessage+ Right txtContent -> do+ let strContent = Text.unpack txtContent+ strFileName = Path.fromRelFile filePathForMessages++ fmtAction :: IO FileContent+ fmtAction =+ Formatter.utf8TextToFileContent+ <$> Ormolu.ormolu config strFileName strContent++ recovery :: Ormolu.OrmoluException -> IO (FormattingResult FileContent)+ recovery e =+ pure . Formatter.Error . Formatter.ErrorMessage . ShortText.pack $+ "hspretty: Ormolu error when formatting file \""+ <> Path.fromRelFile filePathForMessages+ <> "\": "+ <> UnliftIO.displayException e++ result <- UnliftIO.catch (Right <$> fmtAction) (fmap Left <$> recovery)++ case result of+ Left err -> pure err+ Right outFileContent ->+ pure $+ if outFileContent == content+ then Formatter.Unchanged+ else Formatter.Changed outFileContent++-- | A 'PathFilter' for @.hs@ files.+pfHs :: PathFilter+pfHs = PathFilter.pfExtension ".hs"
+ src/Log.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Description : Logging of CLI actions.+module Log+ ( -- * Types+ Log (..),++ -- ** Default Logger+ defaultLog,+ )+where++import qualified Data.Text as Text+import qualified Data.Text.IO+import Data.Text.Short (ShortText)+import qualified Data.Text.Short as ShortText+import Formatter (FormattingResult)+import qualified Formatter+import Path (File, Path, Rel, fromRelFile)+import qualified System.Console.ANSI as ANSI++-- | A logger.+--+-- All messages set to the user go through this interface.+data Log = Log+ { info :: ShortText -> IO (),+ report :: Path Rel File -> FormattingResult () -> IO ()+ }++-- | Default logger.+defaultLog :: Log+defaultLog =+ Log+ { info = defaultInfo,+ report = defaultReport+ }++defaultInfo :: ShortText -> IO ()+defaultInfo = Data.Text.IO.putStrLn . ShortText.toText++defaultReport :: Path Rel File -> FormattingResult () -> IO ()+defaultReport file result =+ case result of+ Formatter.NotFormatted -> pure ()+ Formatter.Unchanged -> do+ boxTick+ Data.Text.IO.putStr " - "+ putFileName file+ Data.Text.IO.putStr "\n"+ Formatter.Changed () -> do+ boxF+ Data.Text.IO.putStr " - "+ putFileName file+ Data.Text.IO.putStr "\n"+ Formatter.Error msg -> do+ boxCross+ Data.Text.IO.putStr " - "+ putFileName file+ Data.Text.IO.putStr "\n"+ Data.Text.IO.putStrLn . ShortText.toText . Formatter.unErrorMessage $ msg++putFileName :: Path Rel File -> IO ()+putFileName = Data.Text.IO.putStr . Text.pack . Path.fromRelFile++boxTick :: IO ()+boxTick = do+ Data.Text.IO.putStr "["+ ANSI.setSGR [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green]+ Data.Text.IO.putStr "✓"+ ANSI.setSGR [ANSI.Reset]+ Data.Text.IO.putStr "]"++boxF :: IO ()+boxF = do+ Data.Text.IO.putStr "["+ ANSI.setSGR [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Yellow]+ Data.Text.IO.putStr "F"+ ANSI.setSGR [ANSI.Reset]+ Data.Text.IO.putStr "]"++boxCross :: IO ()+boxCross = do+ Data.Text.IO.putStr "["+ ANSI.setSGR [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red]+ Data.Text.IO.putStr "✕"+ ANSI.setSGR [ANSI.Reset]+ Data.Text.IO.putStr "]"
+ src/PathFilter.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Description : Filters for file paths.+module PathFilter where++import Data.Text.Short (ShortText)+import qualified Data.Text.Short as ShortText+import Path (Dir, File, Path, Rel)+import qualified Path++-- | Does a filter accept a path?+data PathAccept+ = -- | Filter accepts the path.+ Accept+ | -- | Filter rejects the path.+ Reject+ deriving (Show)++-- | Convert a 'PathAccept' type to a 'Bool' suitable for filtering.+toBool :: PathAccept -> Bool+toBool Accept = True+toBool Reject = False++-- | Convert a 'Bool' to a 'PathAccept'.+fromBool :: Bool -> PathAccept+fromBool True = Accept+fromBool False = Reject++-- | Path filter: examine a relative file and decide if we accept it.+newtype PathFilter = PathFilter+ { unPathFilter :: Path Rel File -> PathAccept+ }++instance Semigroup PathFilter where+ f1 <> f2 = PathFilter $ \path ->+ case unPathFilter f1 path of+ Reject -> Reject+ Accept -> unPathFilter f2 path++instance Monoid PathFilter where+ mempty = PathFilter $ const Accept++-- | PathFilter that excludes hidden files or directories, starting with a+-- period.+--+-- For example:+--+-- >>> :set -XQuasiQuotes+-- >>> import qualified Path+-- >>> unPathFilter pfNoHidden [Path.relfile|src/.hidden/something.txt|]+-- Reject+-- >>> unPathFilter pfNoHidden [Path.relfile|src/nothidden/something.txt|]+-- Accept+pfNoHidden :: PathFilter+pfNoHidden = componentFilter (fromBool . ShortText.isPrefixOf ".")++-- | PathFilter that excludes any path components that are named+-- @dist-newstyle@.+pfNoDistNewstyle :: PathFilter+pfNoDistNewstyle = componentFilter (fromBool . (==) "dist-newstyle")++-- | PathFilter that keeps only files with a given extension.+--+-- The extension to be tested should start with a period.+--+-- For example:+--+-- >>> :set -XQuasiQuotes -XOverloadedStrings+-- >>> import qualified Path+-- >>> pfHs = pfExtension ".hs"+-- >>> unPathFilter pfHs [Path.relfile|src/ModuleA/ModuleB.hs|]+-- Accept+-- >>> unPathFilter pfHs [Path.relfile|src/ModuleA/something.txt|]+-- Reject+pfExtension :: ShortText -> PathFilter+pfExtension extension = PathFilter $ \path -> fromBool (extensionMatches path)+ where+ extensionMatches :: Path Rel File -> Bool+ extensionMatches path = extension == ext path++ ext :: Path Rel File -> ShortText+ ext path = maybe "" ShortText.pack (Path.fileExtension path)++-- | Create a filter from a function that examines each component of a path.+componentFilter :: (ShortText -> PathAccept) -> PathFilter+componentFilter f = PathFilter $ \path ->+ fromBool . not . any (toBool . f) . pathComponents $ path++-- | Return the components of a path as a list.+--+-- For example:+--+-- >>> :set -XQuasiQuotes+-- >>> import qualified Path+-- >>> pathComponents [Path.relfile|dir/package/file.txt|]+-- ["dir","package","file.txt"]+-- >>> pathComponents [Path.relfile|file.txt|]+-- ["file.txt"]+pathComponents :: Path Rel File -> [ShortText]+pathComponents filePath = components+ where+ components :: [ShortText]+ components = reverse (fileName : pathParts)++ fileName :: ShortText+ fileName = ShortText.pack . Path.fromRelFile . Path.filename $ filePath++ pathParts :: [ShortText]+ pathParts = go (Path.parent filePath)++ go :: Path Rel Dir -> [ShortText]+ go dir+ | isTopDir dir = []+ | otherwise = curDirComp dir : go (Path.parent dir)+ where+ isTopDir :: Path Rel Dir -> Bool+ isTopDir d = Path.parent d == d++ curDirComp :: Path Rel Dir -> ShortText+ curDirComp d =+ ShortText.pack . init . Path.fromRelDir . Path.dirname $ d
+ src/RunMode.hs view
@@ -0,0 +1,13 @@+-- |+-- Description : Run mode: check only or format.+module RunMode+ ( RunMode (CheckOnly, Format),+ )+where++-- | Running mode: are we only checking, or also formatting?+data RunMode+ = -- | Only check files (read only).+ CheckOnly+ | -- | Format files (read and write).+ Format
+ test/Test.hs view
@@ -0,0 +1,26 @@+-- |+-- Description : Main entry point for tests.+module Main where++import qualified Test.DocTest as DocTest++main :: IO ()+main = runDocTests++runDocTests :: IO ()+runDocTests = do+ putStrLn "┌───────────────────┐"+ putStrLn "│ Starting DocTests │"+ putStrLn "└───────────────────┘"+ docTests+ putStrLn "┌───────────────────┐"+ putStrLn "│ Finished DocTests │"+ putStrLn "└───────────────────┘"++docTests :: IO ()+docTests =+ DocTest.doctest+ [ "-isrc",+ "src/Formatter.hs",+ "src/PathFilter.hs"+ ]