ormolu/app/Main.hs

{-# LANGUAGE CPP             #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Main (main) where

import Control.Monad
import Data.List (intercalate)
import Data.Version (showVersion)
import Development.GitRev
import Options.Applicative
import Ormolu
import Ormolu.Parser (manualExts)
import Ormolu.Utils (showOutputable)
import Paths_ormolu (version)
import System.Exit (ExitCode (..), exitWith)
import System.IO (hPutStrLn, stderr)
import qualified Data.Text.IO as TIO

-- | Entry point of the program.

main :: IO ()
main = withPrettyOrmoluExceptions $ do
  Opts {..} <- execParser optsParserInfo
  r <- case optInputFile of
    "-" -> ormoluStdin optConfig
    inputFile -> ormoluFile optConfig inputFile
  let notForStdin = do
        when (optInputFile == "-") $ do
          hPutStrLn
            stderr
            "This feature is not supported when input comes from stdin."
          -- 101 is different from all the other exit codes we already use.
          exitWith (ExitFailure 101)
  case optMode of
    Stdout ->
      TIO.putStr r
    InPlace -> do
      notForStdin
      TIO.writeFile optInputFile r
    Check -> do
      notForStdin
      r' <- TIO.readFile optInputFile
      when (r /= r') $
        -- 100 is different to all the other exit code that are emitted
        -- either from an 'OrmoluException' or from 'error' and
        -- 'notImplemented'.
        exitWith (ExitFailure 100)

----------------------------------------------------------------------------
-- Command line options parsing.

data Opts = Opts
  { optMode :: !Mode
    -- ^ Mode of operation
  , optConfig :: !Config
    -- ^ Ormolu 'Config'
  , optInputFile :: !FilePath
    -- ^ Input source file or stdin ("-")
  }

-- | 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 <*> exts <*> 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 " ++ VERSION_ghc
      ]
    exts :: Parser (a -> a)
    exts = infoOption displayExts . mconcat $
      [ long "manual-exts"
      , help "Display extensions that need to be enabled manually"
      ]
    displayExts = unlines (showOutputable <$> manualExts)

optsParser :: Parser Opts
optsParser = Opts
  <$> (option parseMode . mconcat)
    [ long "mode"
    , short 'm'
    , metavar "MODE"
    , value Stdout
    , help "Mode of operation: 'stdout', 'inplace', or 'check'"
    ]
  <*> configParser
  <*> (strArgument . mconcat)
    [ metavar "FILE"
    , value "-"
    , help "Haskell source file to format or stdin (default)"
    ]

configParser :: Parser Config
configParser = Config
  <$> (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 "unsafe"
    , short 'u'
    , help "Do formatting faster but without automatic detection of defects"
    ]
  <*> (switch . mconcat)
    [ long "debug"
    , short 'd'
    , help "Output information useful for debugging"
    ]
  <*> (switch . mconcat)
    [ long "tolerate-cpp"
    , short 'p'
    , help "Do not fail if CPP pragma is present"
    ]

----------------------------------------------------------------------------
-- Helpers

-- | Parse 'Mode'.

parseMode :: ReadM Mode
parseMode = eitherReader $ \case
  "stdout" -> Right Stdout
  "inplace" -> Right InPlace
  "check" -> Right Check
  s -> Left $ "unknown mode: " ++ s