Implement CLI for the application

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

ormolu.cabal

@@ -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

src/Ormolu.hs

@@ -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

src/Ormolu/Config.hs

@@ -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'@.
 

src/Ormolu/Printer.hs

@@ -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

tests/Ormolu/PrinterSpec.hs

@@ -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.