-- | This module defines the main entry point for the application.
module CabalGild.Main where

import qualified CabalGild.Action.AttachComments as AttachComments
import qualified CabalGild.Action.EvaluatePragmas as EvaluatePragmas
import qualified CabalGild.Action.ExtractComments as ExtractComments
import qualified CabalGild.Action.FormatFields as FormatFields
import qualified CabalGild.Action.GetCabalVersion as GetCabalVersion
import qualified CabalGild.Action.ReflowText as ReflowText
import qualified CabalGild.Action.RemovePositions as RemovePositions
import qualified CabalGild.Action.Render as Render
import qualified CabalGild.Action.StripBlanks as StripBlanks
import qualified CabalGild.Class.MonadLog as MonadLog
import qualified CabalGild.Class.MonadRead as MonadRead
import qualified CabalGild.Class.MonadWalk as MonadWalk
import qualified CabalGild.Class.MonadWrite as MonadWrite
import qualified CabalGild.Exception.CheckFailure as CheckFailure
import qualified CabalGild.Exception.ParseError as ParseError
import qualified CabalGild.Type.Config as Config
import qualified CabalGild.Type.Context as Context
import qualified CabalGild.Type.Flag as Flag
import qualified CabalGild.Type.Input as Input
import qualified CabalGild.Type.Mode as Mode
import qualified Control.Monad as Monad
import qualified Control.Monad.Catch as Exception
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Latin1
import qualified Distribution.Fields as Fields
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.IO as IO

-- | This is the main entry point for the application. It gets the command line
-- arguments and then hands things off to 'mainWith'. If any exceptions are
-- thrown, they will be handled by 'onException'.
defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = (SomeException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
Exception.handle SomeException -> IO ()
forall a. SomeException -> IO a
onException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  [String]
arguments <- IO [String]
Environment.getArgs
  [String] -> IO ()
forall (m :: * -> *).
(MonadLog m, MonadRead m, MonadThrow m, MonadWalk m,
 MonadWrite m) =>
[String] -> m ()
mainWith [String]
arguments

-- | If the exception was an 'Exit.ExitCode', simply exit with that code.
-- Otherwise handle exceptions by printing them to STDERR using
-- 'Exception.displayException' instead of 'show'. Then exit with a failing
-- status code.
onException :: Exception.SomeException -> IO a
onException :: forall a. SomeException -> IO a
onException SomeException
e = case SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
Exception.fromException SomeException
e of
  Just ExitCode
exitCode -> ExitCode -> IO a
forall a. ExitCode -> IO a
Exit.exitWith ExitCode
exitCode
  Maybe ExitCode
Nothing -> do
    Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall e. Exception e => e -> String
Exception.displayException SomeException
e
    IO a
forall a. IO a
Exit.exitFailure

-- | The actual logic for the command line application. This is written using
-- constraints so that it can be run in pure code if so desired. But most often
-- this will be run in 'IO'.
mainWith ::
  ( MonadLog.MonadLog m,
    MonadRead.MonadRead m,
    Exception.MonadThrow m,
    MonadWalk.MonadWalk m,
    MonadWrite.MonadWrite m
  ) =>
  [String] ->
  m ()
mainWith :: forall (m :: * -> *).
(MonadLog m, MonadRead m, MonadThrow m, MonadWalk m,
 MonadWrite m) =>
[String] -> m ()
mainWith [String]
arguments = do
  [Flag]
flags <- [String] -> m [Flag]
forall (m :: * -> *). MonadThrow m => [String] -> m [Flag]
Flag.fromArguments [String]
arguments
  Config
config <- [Flag] -> m Config
forall (m :: * -> *). MonadThrow m => [Flag] -> m Config
Config.fromFlags [Flag]
flags
  Context
context <- Config -> m Context
forall (m :: * -> *).
(MonadLog m, MonadThrow m) =>
Config -> m Context
Context.fromConfig Config
config

  let source :: Input
source = Context -> Input
Context.input Context
context
  ByteString
input <- Input -> m ByteString
forall (m :: * -> *). MonadRead m => Input -> m ByteString
MonadRead.read Input
source
  [Field Position]
fields <-
    (ParseError -> m [Field Position])
-> ([Field Position] -> m [Field Position])
-> Either ParseError [Field Position]
-> m [Field Position]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseError -> m [Field Position]
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM (ParseError -> m [Field Position])
-> (ParseError -> ParseError) -> ParseError -> m [Field Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> ParseError
ParseError.ParseError) [Field Position] -> m [Field Position]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError [Field Position] -> m [Field Position])
-> Either ParseError [Field Position] -> m [Field Position]
forall a b. (a -> b) -> a -> b
$
      ByteString -> Either ParseError [Field Position]
Fields.readFields ByteString
input
  let csv :: CabalSpecVersion
csv = [Field Position] -> CabalSpecVersion
forall a. [Field a] -> CabalSpecVersion
GetCabalVersion.fromFields [Field Position]
fields
      comments :: [Comment Position]
comments = ByteString -> [Comment Position]
ExtractComments.fromByteString ByteString
input
      path :: String
path = case Input
source of
        Input
Input.Stdin -> Context -> String
Context.stdin Context
context
        Input.File String
f -> String
f
  ByteString
output <-
    ( ([Field Position], [Comment Position])
-> m ([Field Position], [Comment Position])
forall (m :: * -> *) a cs.
Applicative m =>
([Field a], cs) -> m ([Field a], cs)
StripBlanks.run
        (([Field Position], [Comment Position])
 -> m ([Field Position], [Comment Position]))
-> (([Field Position], [Comment Position]) -> m ByteString)
-> ([Field Position], [Comment Position])
-> m ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
Monad.>=> ([Field Position], [Comment Position])
-> m ([Field (Position, [Comment Position])], [Comment Position])
forall (m :: * -> *) p.
(Applicative m, Ord p) =>
([Field p], [Comment p])
-> m ([Field (p, [Comment p])], [Comment p])
AttachComments.run
        (([Field Position], [Comment Position])
 -> m ([Field (Position, [Comment Position])], [Comment Position]))
-> (([Field (Position, [Comment Position])], [Comment Position])
    -> m ByteString)
-> ([Field Position], [Comment Position])
-> m ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
Monad.>=> CabalSpecVersion
-> ([Field (Position, [Comment Position])], [Comment Position])
-> m ([Field (Position, [Comment Position])], [Comment Position])
forall (m :: * -> *) cs.
Applicative m =>
CabalSpecVersion
-> ([Field (Position, [Comment Position])], cs)
-> m ([Field (Position, [Comment Position])], cs)
ReflowText.run CabalSpecVersion
csv
        (([Field (Position, [Comment Position])], [Comment Position])
 -> m ([Field (Position, [Comment Position])], [Comment Position]))
-> (([Field (Position, [Comment Position])], [Comment Position])
    -> m ByteString)
-> ([Field (Position, [Comment Position])], [Comment Position])
-> m ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
Monad.>=> ([Field (Position, [Comment Position])], [Comment Position])
-> m ([Field [Comment ()]], [Comment ()])
forall (m :: * -> *) p.
Applicative m =>
([Field (p, [Comment p])], [Comment p])
-> m ([Field [Comment ()]], [Comment ()])
RemovePositions.run
        (([Field (Position, [Comment Position])], [Comment Position])
 -> m ([Field [Comment ()]], [Comment ()]))
-> (([Field [Comment ()]], [Comment ()]) -> m ByteString)
-> ([Field (Position, [Comment Position])], [Comment Position])
-> m ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
Monad.>=> String
-> ([Field [Comment ()]], [Comment ()])
-> m ([Field [Comment ()]], [Comment ()])
forall (m :: * -> *) a cs.
MonadWalk m =>
String -> ([Field [Comment a]], cs) -> m ([Field [Comment a]], cs)
EvaluatePragmas.run String
path
        (([Field [Comment ()]], [Comment ()])
 -> m ([Field [Comment ()]], [Comment ()]))
-> (([Field [Comment ()]], [Comment ()]) -> m ByteString)
-> ([Field [Comment ()]], [Comment ()])
-> m ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
Monad.>=> CabalSpecVersion
-> ([Field [Comment ()]], [Comment ()])
-> m ([Field [Comment ()]], [Comment ()])
forall (m :: * -> *) cs.
(Applicative m, Monoid cs) =>
CabalSpecVersion -> ([Field cs], cs) -> m ([Field cs], cs)
FormatFields.run CabalSpecVersion
csv
        (([Field [Comment ()]], [Comment ()])
 -> m ([Field [Comment ()]], [Comment ()]))
-> (([Field [Comment ()]], [Comment ()]) -> m ByteString)
-> ([Field [Comment ()]], [Comment ()])
-> m ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
Monad.>=> ([Field [Comment ()]], [Comment ()]) -> m ByteString
forall (m :: * -> *) a.
Applicative m =>
([Field [Comment a]], [Comment a]) -> m ByteString
Render.run
      )
      ([Field Position]
fields, [Comment Position]
comments)

  case Context -> Mode
Context.mode Context
context of
    Mode
Mode.Check -> do
      -- The input might have CRLF ("\r\n", 0x0d 0x0a) line endings, but the
      -- output will always have LF line endings. For the purposes of the check
      -- command, we'll consider the input formatted if it only differs from
      -- the output in line endings.
      let outputLines :: [ByteString]
outputLines = ByteString -> [ByteString]
Latin1.lines ByteString
output
          stripCR :: ByteString -> ByteString
stripCR ByteString
x = case ByteString -> Maybe (ByteString, Word8)
ByteString.unsnoc ByteString
x of
            Just (ByteString
y, Word8
0x0d) -> ByteString
y
            Maybe (ByteString, Word8)
_ -> ByteString
x
          inputLines :: [ByteString]
inputLines = ByteString -> ByteString
stripCR (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [ByteString]
Latin1.lines ByteString
input
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when ([ByteString]
outputLines [ByteString] -> [ByteString] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ByteString]
inputLines) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        CheckFailure -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM CheckFailure
CheckFailure.CheckFailure
    Mode
Mode.Format -> do
      let target :: Output
target = Context -> Output
Context.output Context
context
      Output -> ByteString -> m ()
forall (m :: * -> *). MonadWrite m => Output -> ByteString -> m ()
MonadWrite.write Output
target ByteString
output