on master help sign in
Implement CLI for the application
2f73baemrkkrp
app/Main.hs+135−25
@@ -1,32 +1,142 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE LambdaCase #-}
3+{-# LANGUAGE RecordWildCards #-}
4+{-# LANGUAGE TemplateHaskell #-}
5+
1module Main (main) where
6module Main (main) where
2
7
3−-- import Control.Monad
8+import Control.Monad
9+import Data.List (intercalate)
10+import Data.Version (showVersion)
11+import Development.GitRev
12+import Options.Applicative
4import Ormolu
13import Ormolu
5−import System.Environment (getArgs)
14+import Paths_ormolu (version)
15+import System.Exit (exitFailure)
6import qualified Data.Text.IO as TIO
16import qualified Data.Text.IO as TIO
7−-- import qualified Outputable as GHC
17+import qualified Data.Yaml as Yaml
18+
19+-- | Entry point of the program.
8
20
9main :: IO ()
21main :: IO ()
10main = withPrettyOrmoluExceptions $ do
22main = withPrettyOrmoluExceptions $ do
11− (path:_) <- getArgs
23+ Opts {..} <- execParser optsParserInfo
12− r <- ormoluFile defaultConfig path
24+ config <- case optConfigFile of
25+ Nothing -> return Config
26+ { cfgDynOptions = optDynOptions
27+ , cfgUnsafe = optUnsafe
28+ }
29+ Just path -> do
30+ Config {..} <- Yaml.decodeFileThrow path
31+ return Config
32+ { cfgDynOptions = cfgDynOptions ++ optDynOptions
33+ , cfgUnsafe = optUnsafe || cfgUnsafe
34+ }
35+ r <- ormoluFile config optDebug optInputFile
36+ case optMode of
37+ Stdout ->
13− TIO.putStr r
38+ TIO.putStr r
14− -- TIO.
39+ InPlace ->
15−
40+ TIO.writeFile optInputFile r
16− -- input <- readFile path
41+ Check -> do
17−
42+ r' <- TIO.readFile optInputFile
18− -- (ws, r) <- parseModule [] path input
43+ when (r /= r') exitFailure
19− -- unless (null ws) $
44+
20− -- putStrLn "dynamic option warnings:"
45+----------------------------------------------------------------------------
21− -- case r of
46+-- Command line options parsing.
22− -- Left (srcSpan, err) -> do
47+
23− -- putStrLn (showOutputable srcSpan)
48+data Opts = Opts
24− -- putStrLn err
49+ { optMode :: !Mode
25− -- Right (anns, parsedModule) -> do
50+ -- ^ Mode of operation
26− -- putStrLn "\nannotations:\n"
51+ , optConfigFile :: !(Maybe FilePath)
27− -- putStrLn (showOutputable anns)
52+ -- ^ Location of configuration file (optional)
28− -- putStrLn "\nparsed module:\n"
53+ , optUnsafe :: !Bool
29− -- putStrLn (showOutputable parsedModule)
54+ -- ^ Whether to skip sanity checking
30−
55+ , optDynOptions :: ![DynOption]
31−-- showOutputable :: GHC.Outputable o => o -> String
56+ -- ^ GHC options to set
32−-- showOutputable = GHC.showSDocUnsafe . GHC.ppr
57+ , optDebug :: !Bool
58+ -- ^ Output information useful for debugging
59+ , optInputFile :: !FilePath
60+ -- ^ Input source file
61+ }
62+
63+-- | Mode of operation.
64+
65+data Mode
66+ = Stdout -- ^ Output formatted source code to stdout
67+ | InPlace -- ^ Overwrite original file
68+ | Check -- ^ Exit with non-zero status code if
69+ -- source is not already formatted
70+ deriving (Eq, Show)
71+
72+optsParserInfo :: ParserInfo Opts
73+optsParserInfo = info (helper <*> ver <*> optsParser) . mconcat $
74+ [ fullDesc
75+ , progDesc ""
76+ , header ""
77+ ]
78+ where
79+ ver :: Parser (a -> a)
80+ ver = infoOption verStr . mconcat $
81+ [ long "version"
82+ , short 'v'
83+ , help "Print version of the program"
84+ ]
85+ verStr = intercalate "\n"
86+ [ unwords
87+ [ "ormolu"
88+ , showVersion version
89+ , $gitBranch
90+ , $gitHash
91+ ]
92+ , "using ghc-exactprint " ++ VERSION_ghc_exactprint
93+ , "using ghc " ++ VERSION_ghc
94+ ]
95+
96+optsParser :: Parser Opts
97+optsParser = Opts
98+ <$> (option parseMode . mconcat)
99+ [ long "mode"
100+ , short 'm'
101+ , metavar "MODE"
102+ , value Stdout
103+ , help "Mode of operation: 'stdout', 'inplace', or 'check'"
104+ ]
105+ <*> (optional . strOption . mconcat)
106+ [ long "config"
107+ , short 'c'
108+ , metavar "CONFIG"
109+ , help "Location of configuration file"
110+ ]
111+ <*> (switch . mconcat)
112+ [ long "unsafe"
113+ , short 'u'
114+ , help "Do formatting faster but without automatic detection of defects"
115+ ]
116+ <*> (fmap (fmap DynOption) . many . strOption . mconcat)
117+ [ long "ghc-opt"
118+ , short 'o'
119+ , metavar "OPT"
120+ , help "GHC options to enable (e.g. language extensions)"
121+ ]
122+ <*> (switch . mconcat)
123+ [ long "debug"
124+ , short 'd'
125+ , help "Output information useful for debugging"
126+ ]
127+ <*> (strArgument . mconcat)
128+ [ metavar "FILE"
129+ , help "Haskell source file to format"
130+ ]
131+
132+----------------------------------------------------------------------------
133+-- Helpers
134+
135+-- | Parse 'Mode'.
136+
137+parseMode :: ReadM Mode
138+parseMode = eitherReader $ \case
139+ "stdout" -> Right Stdout
140+ "inplace" -> Right InPlace
141+ "check" -> Right Check
142+ s -> Left $ "unknown mode: " ++ s
ormolu.cabal+6
@@ -36,6 +36,7 @@ library
36 , mtl >= 2.0 && < 3.0
36 , mtl >= 2.0 && < 3.0
37 , syb >= 0.7 && < 0.8
37 , syb >= 0.7 && < 0.8
38 , text >= 0.2 && < 1.3
38 , text >= 0.2 && < 1.3
39+ , yaml >= 0.8 && < 0.12
39 exposed-modules: Ormolu
40 exposed-modules: Ormolu
40 , Ormolu.Comments
41 , Ormolu.Comments
41 , Ormolu.Config
42 , Ormolu.Config
@@ -84,8 +85,13 @@ executable ormolu
84 hs-source-dirs: app
85 hs-source-dirs: app
85 build-depends: base >= 4.8 && < 5.0
86 build-depends: base >= 4.8 && < 5.0
86 , ghc >= 8.4.3
87 , ghc >= 8.4.3
88+ , ghc-exactprint >= 0.5.6
89+ , gitrev >= 1.3 && < 1.4
90+ , optparse-applicative >= 0.14 && < 0.15
87 , ormolu
91 , ormolu
88 , text >= 0.2 && < 1.3
92 , text >= 0.2 && < 1.3
93+ , yaml >= 0.8 && < 0.12
94+ other-modules: Paths_ormolu
89 if flag(dev)
95 if flag(dev)
90 ghc-options: -Wall -Werror -Wcompat
96 ghc-options: -Wall -Werror -Wcompat
91 -Wincomplete-record-updates
97 -Wincomplete-record-updates
src/Ormolu.hs+34−10
@@ -17,14 +17,17 @@ import Control.Exception
17import Control.Monad
17import Control.Monad
18import Control.Monad.IO.Class (MonadIO (..))
18import Control.Monad.IO.Class (MonadIO (..))
19import Data.Text (Text)
19import Data.Text (Text)
20+import Debug.Trace
20import Language.Haskell.GHC.ExactPrint.Types
21import Language.Haskell.GHC.ExactPrint.Types
21import Ormolu.Config
22import Ormolu.Config
22import Ormolu.Diff
23import Ormolu.Diff
23import Ormolu.Exception
24import Ormolu.Exception
24import Ormolu.Parser
25import Ormolu.Parser
25import Ormolu.Printer
26import Ormolu.Printer
27+import qualified CmdLineParser as GHC
26import qualified Data.Text as T
28import qualified Data.Text as T
27import qualified GHC
29import qualified GHC
30+import qualified Outputable as GHC
28
31
29-- | Format a 'String', return formatted version as 'Text'.
32-- | Format a 'String', return formatted version as 'Text'.
30--
33--
@@ -40,17 +43,23 @@ import qualified GHC
40ormolu
43ormolu
41 :: MonadIO m
44 :: MonadIO m
42 => Config -- ^ Ormolu configuration
45 => Config -- ^ Ormolu configuration
46+ -> Bool -- ^ Output debugging info
43 -> FilePath -- ^ Location of source file
47 -> FilePath -- ^ Location of source file
44 -> String -- ^ Input to format
48 -> String -- ^ Input to format
45 -> m Text
49 -> m Text
46−ormolu cfg path str = do
50+ormolu cfg debugOn path str = do
47− (anns0, parsedSrc0) <-
51+ (ws, (anns0, parsedSrc0)) <-
48 parseModule' cfg OrmoluParsingFailed path str
52 parseModule' cfg OrmoluParsingFailed path str
53+ when debugOn $ do
54+ traceM "warnings:\n"
55+ traceM (concatMap showWarn ws)
56+ traceM "anns:\n"
57+ traceM (showOutputable anns0)
49− let txt = printModule anns0 parsedSrc0
58+ let txt = printModule debugOn anns0 parsedSrc0
50 -- Parse the result of pretty-printing again and make sure that AST is the
59 -- Parse the result of pretty-printing again and make sure that AST is the
51 -- same as AST of original snippet module span positions.
60 -- same as AST of original snippet module span positions.
52− when (cfgSanityCheck cfg) $ do
61+ unless (cfgUnsafe cfg) $ do
53− (anns1, parsedSrc1) <-
62+ (_, (anns1, parsedSrc1)) <-
54 parseModule' cfg OrmoluOutputParsingFailed "<rendered>" (T.unpack txt)
63 parseModule' cfg OrmoluOutputParsingFailed "<rendered>" (T.unpack txt)
55 when (diff (anns0, parsedSrc0) (anns1, parsedSrc1)) $
64 when (diff (anns0, parsedSrc0) (anns1, parsedSrc1)) $
56 liftIO $ throwIO (OrmoluASTDiffers str txt)
65 liftIO $ throwIO (OrmoluASTDiffers str txt)
@@ -65,10 +74,14 @@ ormolu cfg path str = do
65ormoluFile
74ormoluFile
66 :: MonadIO m
75 :: MonadIO m
67 => Config -- ^ Ormolu configuration
76 => Config -- ^ Ormolu configuration
77+ -> Bool -- ^ Output debugging info
68 -> FilePath -- ^ Location of source file
78 -> FilePath -- ^ Location of source file
69 -> m Text -- ^ Resulting rendition
79 -> m Text -- ^ Resulting rendition
70−ormoluFile cfg path =
80+ormoluFile cfg debugOn path =
71− liftIO (readFile path) >>= ormolu cfg path
81+ liftIO (readFile path) >>= ormolu cfg debugOn path
82+
83+----------------------------------------------------------------------------
84+-- Helpers
72
85
73-- | A wrapper around 'parseModule'.
86-- | A wrapper around 'parseModule'.
74
87
@@ -79,9 +92,20 @@ parseModule'
79 -- ^ How to obtain 'OrmoluException' to throw when parsing fails
92 -- ^ How to obtain 'OrmoluException' to throw when parsing fails
80 -> FilePath -- ^ File name to use in errors
93 -> FilePath -- ^ File name to use in errors
81 -> String -- ^ Actual input for the parser
94 -> String -- ^ Actual input for the parser
82− -> m (Anns, GHC.ParsedSource) -- ^ Annotations and parsed source
95+ -> m ([GHC.Warn], (Anns, GHC.ParsedSource)) -- ^ Annotations and parsed source
83parseModule' Config {..} mkException path str = do
96parseModule' Config {..} mkException path str = do
84− (_, r) <- parseModule cfgDynOptions path str
97+ (ws, r) <- parseModule cfgDynOptions path str
85 case r of
98 case r of
86 Left (spn, err) -> liftIO $ throwIO (mkException spn err)
99 Left (spn, err) -> liftIO $ throwIO (mkException spn err)
87− Right x -> return x
100+ Right x -> return (ws, x)
101+
102+-- | Pretty-print a 'GHC.Warn'.
103+
104+showWarn :: GHC.Warn -> String
105+showWarn (GHC.Warn reason l) =
106+ showOutputable reason ++ "\n" ++ showOutputable l ++ "\n"
107+
108+-- | Pretty-print an 'GHC.Outputable' thing.
109+
110+showOutputable :: GHC.Outputable o => o -> String
111+showOutputable = GHC.showSDocUnsafe . GHC.ppr
src/Ormolu/Config.hs+16−7
@@ -1,5 +1,9 @@
1-- | Configuration options used by the tool.
1-- | Configuration options used by the tool.
2
2
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE OverloadedStrings #-}
5+{-# LANGUAGE RecordWildCards #-}
6+
3module Ormolu.Config
7module Ormolu.Config
4 ( Config (..)
8 ( Config (..)
5 , defaultConfig
9 , defaultConfig
@@ -8,32 +12,37 @@ module Ormolu.Config
8 )
12 )
9where
13where
10
14
15+import Data.Yaml
11import qualified SrcLoc as GHC
16import qualified SrcLoc as GHC
12
17
13-- | Ormolu configuration.
18-- | Ormolu configuration.
14
19
15data Config = Config
20data Config = Config
16− { cfgDynOptions :: [DynOption]
21+ { cfgDynOptions :: ![DynOption]
17 -- ^ Dynamic options to pass to GHC parser
22 -- ^ Dynamic options to pass to GHC parser
18− , cfgSanityCheck :: Bool
23+ , cfgUnsafe :: !Bool
19− -- ^ Whether to parse output of formatter and compare the obtained AST
24+ -- ^ Do formatting faster but without automatic detection of defects
20− -- with original AST. Doing this makes the program much slower, but
21− -- it'll catch and report all possible issues.
22 } deriving (Eq, Show)
25 } deriving (Eq, Show)
23
26
27+instance FromJSON Config where
28+ parseJSON = withObject "config" $ \o -> do
29+ cfgDynOptions <- o .: "ghc-opts"
30+ cfgUnsafe <- o .: "unsafe"
31+ return Config {..}
32+
24-- | Default 'Config'.
33-- | Default 'Config'.
25
34
26defaultConfig :: Config
35defaultConfig :: Config
27defaultConfig = Config
36defaultConfig = Config
28 { cfgDynOptions = []
37 { cfgDynOptions = []
29− , cfgSanityCheck = True
38+ , cfgUnsafe = False
30 }
39 }
31
40
32-- | A wrapper for dynamic options.
41-- | A wrapper for dynamic options.
33
42
34newtype DynOption = DynOption
43newtype DynOption = DynOption
35 { unDynOption :: String
44 { unDynOption :: String
36− } deriving (Eq, Ord, Show)
45+ } deriving (Eq, Ord, Show, FromJSON)
37
46
38-- | Convert 'DynOption' to @'GHC.Located' 'String'@.
47-- | Convert 'DynOption' to @'GHC.Located' 'String'@.
39
48
src/Ormolu/Printer.hs+4−3
@@ -25,11 +25,12 @@ import SrcLoc (combineSrcSpans)
25-- | Render a module.
25-- | Render a module.
26
26
27printModule
27printModule
28+ :: Bool -- ^ Trace debugging information
28− :: Anns -- ^ Annotations
29+ -> Anns -- ^ Annotations
29 -> ParsedSource -- ^ Parsed source
30 -> ParsedSource -- ^ Parsed source
30 -> Text -- ^ Resulting rendition
31 -> Text -- ^ Resulting rendition
31−printModule anns src =
32+printModule debugOn anns src =
32− runR False (p_HsModule src) anns
33+ runR debugOn (p_HsModule src) anns
33
34
34p_HsModule :: ParsedSource -> R ()
35p_HsModule :: ParsedSource -> R ()
35p_HsModule loc@(L moduleSpan hsModule) = do
36p_HsModule loc@(L moduleSpan hsModule) = do
tests/Ormolu/PrinterSpec.hs+2−2
@@ -29,14 +29,14 @@ checkExample srcPath' = it (fromRelFile srcPath' ++ " works") $ do
29 -- 2. Parse the result of pretty-printing again and make sure that AST
29 -- 2. Parse the result of pretty-printing again and make sure that AST
30 -- is the same as AST of the original snippet. (This happens in
30 -- is the same as AST of the original snippet. (This happens in
31 -- 'ormoluFile' automatically.)
31 -- 'ormoluFile' automatically.)
32− formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath)
32+ formatted0 <- ormoluFile defaultConfig False (fromRelFile srcPath)
33 -- 3. Check the output against expected output. Thus all tests should
33 -- 3. Check the output against expected output. Thus all tests should
34 -- include two files: input and expected output.
34 -- include two files: input and expected output.
35 expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath
35 expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath
36 formatted0 `shouldMatch` expected
36 formatted0 `shouldMatch` expected
37 -- 4. Check that running the formatter on the output produces the same
37 -- 4. Check that running the formatter on the output produces the same
38 -- output again (the transformation is idempotent).
38 -- output again (the transformation is idempotent).
39− formatted1 <- ormolu defaultConfig "<formatted>" (T.unpack formatted0)
39+ formatted1 <- ormolu defaultConfig False "<formatted>" (T.unpack formatted0)
40 formatted1 `shouldMatch` formatted0
40 formatted1 `shouldMatch` formatted0
41
41
42-- | Build list of examples for testing.
42-- | Build list of examples for testing.