mirror of
https://github.com/tweag/ormolu.git
synced 2024-10-26 15:35:11 +03:00
Implement CLI for the application
This commit is contained in:
parent
53285db455
commit
2f73bae977
154
app/Main.hs
154
app/Main.hs
@ -1,32 +1,142 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
|
||||
module Main (main) where
|
||||
|
||||
-- import Control.Monad
|
||||
import Control.Monad
|
||||
import Data.List (intercalate)
|
||||
import Data.Version (showVersion)
|
||||
import Development.GitRev
|
||||
import Options.Applicative
|
||||
import Ormolu
|
||||
import System.Environment (getArgs)
|
||||
import Paths_ormolu (version)
|
||||
import System.Exit (exitFailure)
|
||||
import qualified Data.Text.IO as TIO
|
||||
-- import qualified Outputable as GHC
|
||||
import qualified Data.Yaml as Yaml
|
||||
|
||||
-- | Entry point of the program.
|
||||
|
||||
main :: IO ()
|
||||
main = withPrettyOrmoluExceptions $ do
|
||||
(path:_) <- getArgs
|
||||
r <- ormoluFile defaultConfig path
|
||||
TIO.putStr r
|
||||
-- TIO.
|
||||
Opts {..} <- execParser optsParserInfo
|
||||
config <- case optConfigFile of
|
||||
Nothing -> return Config
|
||||
{ cfgDynOptions = optDynOptions
|
||||
, cfgUnsafe = optUnsafe
|
||||
}
|
||||
Just path -> do
|
||||
Config {..} <- Yaml.decodeFileThrow path
|
||||
return Config
|
||||
{ cfgDynOptions = cfgDynOptions ++ optDynOptions
|
||||
, cfgUnsafe = optUnsafe || cfgUnsafe
|
||||
}
|
||||
r <- ormoluFile config optDebug optInputFile
|
||||
case optMode of
|
||||
Stdout ->
|
||||
TIO.putStr r
|
||||
InPlace ->
|
||||
TIO.writeFile optInputFile r
|
||||
Check -> do
|
||||
r' <- TIO.readFile optInputFile
|
||||
when (r /= r') exitFailure
|
||||
|
||||
-- input <- readFile path
|
||||
----------------------------------------------------------------------------
|
||||
-- Command line options parsing.
|
||||
|
||||
-- (ws, r) <- parseModule [] path input
|
||||
-- unless (null ws) $
|
||||
-- putStrLn "dynamic option warnings:"
|
||||
-- case r of
|
||||
-- Left (srcSpan, err) -> do
|
||||
-- putStrLn (showOutputable srcSpan)
|
||||
-- putStrLn err
|
||||
-- Right (anns, parsedModule) -> do
|
||||
-- putStrLn "\nannotations:\n"
|
||||
-- putStrLn (showOutputable anns)
|
||||
-- putStrLn "\nparsed module:\n"
|
||||
-- putStrLn (showOutputable parsedModule)
|
||||
data Opts = Opts
|
||||
{ optMode :: !Mode
|
||||
-- ^ Mode of operation
|
||||
, optConfigFile :: !(Maybe FilePath)
|
||||
-- ^ Location of configuration file (optional)
|
||||
, optUnsafe :: !Bool
|
||||
-- ^ Whether to skip sanity checking
|
||||
, optDynOptions :: ![DynOption]
|
||||
-- ^ GHC options to set
|
||||
, optDebug :: !Bool
|
||||
-- ^ Output information useful for debugging
|
||||
, optInputFile :: !FilePath
|
||||
-- ^ Input source file
|
||||
}
|
||||
|
||||
-- showOutputable :: GHC.Outputable o => o -> String
|
||||
-- showOutputable = GHC.showSDocUnsafe . GHC.ppr
|
||||
-- | Mode of operation.
|
||||
|
||||
data Mode
|
||||
= Stdout -- ^ Output formatted source code to stdout
|
||||
| InPlace -- ^ Overwrite original file
|
||||
| Check -- ^ Exit with non-zero status code if
|
||||
-- source is not already formatted
|
||||
deriving (Eq, Show)
|
||||
|
||||
optsParserInfo :: ParserInfo Opts
|
||||
optsParserInfo = info (helper <*> ver <*> optsParser) . mconcat $
|
||||
[ fullDesc
|
||||
, progDesc ""
|
||||
, header ""
|
||||
]
|
||||
where
|
||||
ver :: Parser (a -> a)
|
||||
ver = infoOption verStr . mconcat $
|
||||
[ long "version"
|
||||
, short 'v'
|
||||
, help "Print version of the program"
|
||||
]
|
||||
verStr = intercalate "\n"
|
||||
[ unwords
|
||||
[ "ormolu"
|
||||
, showVersion version
|
||||
, $gitBranch
|
||||
, $gitHash
|
||||
]
|
||||
, "using ghc-exactprint " ++ VERSION_ghc_exactprint
|
||||
, "using ghc " ++ VERSION_ghc
|
||||
]
|
||||
|
||||
optsParser :: Parser Opts
|
||||
optsParser = Opts
|
||||
<$> (option parseMode . mconcat)
|
||||
[ long "mode"
|
||||
, short 'm'
|
||||
, metavar "MODE"
|
||||
, value Stdout
|
||||
, help "Mode of operation: 'stdout', 'inplace', or 'check'"
|
||||
]
|
||||
<*> (optional . strOption . mconcat)
|
||||
[ long "config"
|
||||
, short 'c'
|
||||
, metavar "CONFIG"
|
||||
, help "Location of configuration file"
|
||||
]
|
||||
<*> (switch . mconcat)
|
||||
[ long "unsafe"
|
||||
, short 'u'
|
||||
, help "Do formatting faster but without automatic detection of defects"
|
||||
]
|
||||
<*> (fmap (fmap DynOption) . many . strOption . mconcat)
|
||||
[ long "ghc-opt"
|
||||
, short 'o'
|
||||
, metavar "OPT"
|
||||
, help "GHC options to enable (e.g. language extensions)"
|
||||
]
|
||||
<*> (switch . mconcat)
|
||||
[ long "debug"
|
||||
, short 'd'
|
||||
, help "Output information useful for debugging"
|
||||
]
|
||||
<*> (strArgument . mconcat)
|
||||
[ metavar "FILE"
|
||||
, help "Haskell source file to format"
|
||||
]
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Helpers
|
||||
|
||||
-- | Parse 'Mode'.
|
||||
|
||||
parseMode :: ReadM Mode
|
||||
parseMode = eitherReader $ \case
|
||||
"stdout" -> Right Stdout
|
||||
"inplace" -> Right InPlace
|
||||
"check" -> Right Check
|
||||
s -> Left $ "unknown mode: " ++ s
|
||||
|
@ -36,6 +36,7 @@ library
|
||||
, mtl >= 2.0 && < 3.0
|
||||
, syb >= 0.7 && < 0.8
|
||||
, text >= 0.2 && < 1.3
|
||||
, yaml >= 0.8 && < 0.12
|
||||
exposed-modules: Ormolu
|
||||
, Ormolu.Comments
|
||||
, Ormolu.Config
|
||||
@ -84,8 +85,13 @@ executable ormolu
|
||||
hs-source-dirs: app
|
||||
build-depends: base >= 4.8 && < 5.0
|
||||
, ghc >= 8.4.3
|
||||
, ghc-exactprint >= 0.5.6
|
||||
, gitrev >= 1.3 && < 1.4
|
||||
, optparse-applicative >= 0.14 && < 0.15
|
||||
, ormolu
|
||||
, text >= 0.2 && < 1.3
|
||||
, yaml >= 0.8 && < 0.12
|
||||
other-modules: Paths_ormolu
|
||||
if flag(dev)
|
||||
ghc-options: -Wall -Werror -Wcompat
|
||||
-Wincomplete-record-updates
|
||||
|
@ -17,14 +17,17 @@ import Control.Exception
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class (MonadIO (..))
|
||||
import Data.Text (Text)
|
||||
import Debug.Trace
|
||||
import Language.Haskell.GHC.ExactPrint.Types
|
||||
import Ormolu.Config
|
||||
import Ormolu.Diff
|
||||
import Ormolu.Exception
|
||||
import Ormolu.Parser
|
||||
import Ormolu.Printer
|
||||
import qualified CmdLineParser as GHC
|
||||
import qualified Data.Text as T
|
||||
import qualified GHC
|
||||
import qualified Outputable as GHC
|
||||
|
||||
-- | Format a 'String', return formatted version as 'Text'.
|
||||
--
|
||||
@ -40,17 +43,23 @@ import qualified GHC
|
||||
ormolu
|
||||
:: MonadIO m
|
||||
=> Config -- ^ Ormolu configuration
|
||||
-> Bool -- ^ Output debugging info
|
||||
-> FilePath -- ^ Location of source file
|
||||
-> String -- ^ Input to format
|
||||
-> m Text
|
||||
ormolu cfg path str = do
|
||||
(anns0, parsedSrc0) <-
|
||||
ormolu cfg debugOn path str = do
|
||||
(ws, (anns0, parsedSrc0)) <-
|
||||
parseModule' cfg OrmoluParsingFailed path str
|
||||
let txt = printModule anns0 parsedSrc0
|
||||
when debugOn $ do
|
||||
traceM "warnings:\n"
|
||||
traceM (concatMap showWarn ws)
|
||||
traceM "anns:\n"
|
||||
traceM (showOutputable anns0)
|
||||
let txt = printModule debugOn anns0 parsedSrc0
|
||||
-- Parse the result of pretty-printing again and make sure that AST is the
|
||||
-- same as AST of original snippet module span positions.
|
||||
when (cfgSanityCheck cfg) $ do
|
||||
(anns1, parsedSrc1) <-
|
||||
unless (cfgUnsafe cfg) $ do
|
||||
(_, (anns1, parsedSrc1)) <-
|
||||
parseModule' cfg OrmoluOutputParsingFailed "<rendered>" (T.unpack txt)
|
||||
when (diff (anns0, parsedSrc0) (anns1, parsedSrc1)) $
|
||||
liftIO $ throwIO (OrmoluASTDiffers str txt)
|
||||
@ -65,10 +74,14 @@ ormolu cfg path str = do
|
||||
ormoluFile
|
||||
:: MonadIO m
|
||||
=> Config -- ^ Ormolu configuration
|
||||
-> Bool -- ^ Output debugging info
|
||||
-> FilePath -- ^ Location of source file
|
||||
-> m Text -- ^ Resulting rendition
|
||||
ormoluFile cfg path =
|
||||
liftIO (readFile path) >>= ormolu cfg path
|
||||
ormoluFile cfg debugOn path =
|
||||
liftIO (readFile path) >>= ormolu cfg debugOn path
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Helpers
|
||||
|
||||
-- | A wrapper around 'parseModule'.
|
||||
|
||||
@ -79,9 +92,20 @@ parseModule'
|
||||
-- ^ How to obtain 'OrmoluException' to throw when parsing fails
|
||||
-> FilePath -- ^ File name to use in errors
|
||||
-> String -- ^ Actual input for the parser
|
||||
-> m (Anns, GHC.ParsedSource) -- ^ Annotations and parsed source
|
||||
-> m ([GHC.Warn], (Anns, GHC.ParsedSource)) -- ^ Annotations and parsed source
|
||||
parseModule' Config {..} mkException path str = do
|
||||
(_, r) <- parseModule cfgDynOptions path str
|
||||
(ws, r) <- parseModule cfgDynOptions path str
|
||||
case r of
|
||||
Left (spn, err) -> liftIO $ throwIO (mkException spn err)
|
||||
Right x -> return x
|
||||
Right x -> return (ws, x)
|
||||
|
||||
-- | Pretty-print a 'GHC.Warn'.
|
||||
|
||||
showWarn :: GHC.Warn -> String
|
||||
showWarn (GHC.Warn reason l) =
|
||||
showOutputable reason ++ "\n" ++ showOutputable l ++ "\n"
|
||||
|
||||
-- | Pretty-print an 'GHC.Outputable' thing.
|
||||
|
||||
showOutputable :: GHC.Outputable o => o -> String
|
||||
showOutputable = GHC.showSDocUnsafe . GHC.ppr
|
||||
|
@ -1,5 +1,9 @@
|
||||
-- | Configuration options used by the tool.
|
||||
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Ormolu.Config
|
||||
( Config (..)
|
||||
, defaultConfig
|
||||
@ -8,32 +12,37 @@ module Ormolu.Config
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Yaml
|
||||
import qualified SrcLoc as GHC
|
||||
|
||||
-- | Ormolu configuration.
|
||||
|
||||
data Config = Config
|
||||
{ cfgDynOptions :: [DynOption]
|
||||
{ cfgDynOptions :: ![DynOption]
|
||||
-- ^ Dynamic options to pass to GHC parser
|
||||
, cfgSanityCheck :: Bool
|
||||
-- ^ Whether to parse output of formatter and compare the obtained AST
|
||||
-- with original AST. Doing this makes the program much slower, but
|
||||
-- it'll catch and report all possible issues.
|
||||
, cfgUnsafe :: !Bool
|
||||
-- ^ Do formatting faster but without automatic detection of defects
|
||||
} deriving (Eq, Show)
|
||||
|
||||
instance FromJSON Config where
|
||||
parseJSON = withObject "config" $ \o -> do
|
||||
cfgDynOptions <- o .: "ghc-opts"
|
||||
cfgUnsafe <- o .: "unsafe"
|
||||
return Config {..}
|
||||
|
||||
-- | Default 'Config'.
|
||||
|
||||
defaultConfig :: Config
|
||||
defaultConfig = Config
|
||||
{ cfgDynOptions = []
|
||||
, cfgSanityCheck = True
|
||||
, cfgUnsafe = False
|
||||
}
|
||||
|
||||
-- | A wrapper for dynamic options.
|
||||
|
||||
newtype DynOption = DynOption
|
||||
{ unDynOption :: String
|
||||
} deriving (Eq, Ord, Show)
|
||||
} deriving (Eq, Ord, Show, FromJSON)
|
||||
|
||||
-- | Convert 'DynOption' to @'GHC.Located' 'String'@.
|
||||
|
||||
|
@ -25,11 +25,12 @@ import SrcLoc (combineSrcSpans)
|
||||
-- | Render a module.
|
||||
|
||||
printModule
|
||||
:: Anns -- ^ Annotations
|
||||
:: Bool -- ^ Trace debugging information
|
||||
-> Anns -- ^ Annotations
|
||||
-> ParsedSource -- ^ Parsed source
|
||||
-> Text -- ^ Resulting rendition
|
||||
printModule anns src =
|
||||
runR False (p_HsModule src) anns
|
||||
printModule debugOn anns src =
|
||||
runR debugOn (p_HsModule src) anns
|
||||
|
||||
p_HsModule :: ParsedSource -> R ()
|
||||
p_HsModule loc@(L moduleSpan hsModule) = do
|
||||
|
@ -29,14 +29,14 @@ checkExample srcPath' = it (fromRelFile srcPath' ++ " works") $ do
|
||||
-- 2. Parse the result of pretty-printing again and make sure that AST
|
||||
-- is the same as AST of the original snippet. (This happens in
|
||||
-- 'ormoluFile' automatically.)
|
||||
formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath)
|
||||
formatted0 <- ormoluFile defaultConfig False (fromRelFile srcPath)
|
||||
-- 3. Check the output against expected output. Thus all tests should
|
||||
-- include two files: input and expected output.
|
||||
expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath
|
||||
formatted0 `shouldMatch` expected
|
||||
-- 4. Check that running the formatter on the output produces the same
|
||||
-- output again (the transformation is idempotent).
|
||||
formatted1 <- ormolu defaultConfig "<formatted>" (T.unpack formatted0)
|
||||
formatted1 <- ormolu defaultConfig False "<formatted>" (T.unpack formatted0)
|
||||
formatted1 `shouldMatch` formatted0
|
||||
|
||||
-- | Build list of examples for testing.
|
||||
|
Loading…
Reference in New Issue
Block a user