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

import qualified CabalGild.Unstable.Action.AttachComments as AttachComments
import qualified CabalGild.Unstable.Action.EvaluatePragmas as EvaluatePragmas
import qualified CabalGild.Unstable.Action.ExtractComments as ExtractComments
import qualified CabalGild.Unstable.Action.FormatFields as FormatFields
import qualified CabalGild.Unstable.Action.GetCabalVersion as GetCabalVersion
import qualified CabalGild.Unstable.Action.ReflowText as ReflowText
import qualified CabalGild.Unstable.Action.Render as Render
import qualified CabalGild.Unstable.Action.StripBlanks as StripBlanks
import qualified CabalGild.Unstable.Class.MonadHandle as MonadHandle
import qualified CabalGild.Unstable.Class.MonadLog as MonadLog
import qualified CabalGild.Unstable.Class.MonadRead as MonadRead
import qualified CabalGild.Unstable.Class.MonadWalk as MonadWalk
import qualified CabalGild.Unstable.Class.MonadWrite as MonadWrite
import qualified CabalGild.Unstable.Exception.CheckFailure as CheckFailure
import qualified CabalGild.Unstable.Exception.ParseError as ParseError
import qualified CabalGild.Unstable.Extra.ByteString as ByteString
import qualified CabalGild.Unstable.Type.Config as Config
import qualified CabalGild.Unstable.Type.Context as Context
import qualified CabalGild.Unstable.Type.Flag as Flag
import qualified CabalGild.Unstable.Type.Input as Input
import qualified CabalGild.Unstable.Type.Leniency as Leniency
import qualified CabalGild.Unstable.Type.Mode as Mode
import qualified CabalGild.Unstable.Type.Output as Output
import qualified Control.Monad as Monad
import qualified Control.Monad.Catch as Exception
import qualified Data.ByteString as ByteString
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
  arguments <- IO [String]
Environment.getArgs
  mainWith 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 ::
  ( MonadHandle.MonadHandle m,
    MonadLog.MonadLog m,
    MonadRead.MonadRead m,
    Exception.MonadThrow m,
    MonadWalk.MonadWalk m,
    MonadWrite.MonadWrite m
  ) =>
  [String] ->
  m ()
mainWith :: forall (m :: * -> *).
(MonadHandle m, MonadLog m, MonadRead m, MonadThrow m, MonadWalk m,
 MonadWrite m) =>
[String] -> m ()
mainWith [String]
arguments = do
  flags <- [String] -> m [Flag]
forall (m :: * -> *). MonadThrow m => [String] -> m [Flag]
Flag.fromArguments [String]
arguments
  config <- Config.fromFlags flags
  context <- Context.fromConfig config

  input <- MonadRead.read $ Context.input context
  output <- format (Context.stdin context) input

  let formatted = Leniency -> ByteString -> ByteString -> Bool
check (Context -> Leniency
Context.crlf Context
context) ByteString
input ByteString
output
  case Context.mode context of
    Mode
Mode.Check -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.unless Bool
formatted (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 -> case (Context -> Input
Context.input Context
context, Context -> Output
Context.output Context
context) of
      (Input.File String
i, Output.File String
o) | Bool
formatted, String
i String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
o -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (Input
_, Output
o) -> Output -> ByteString -> m ()
forall (m :: * -> *). MonadWrite m => Output -> ByteString -> m ()
MonadWrite.write Output
o ByteString
output

-- | Formats the given input using the provided file path as the apparent
-- source file (see 'Context.stdin'). An exception will be thrown if the input
-- is invalid. The 'MonadWalk.MonadWalk' constraint is used to discover modules
-- on the file system. Typically @m@ will be 'IO'.
format ::
  (Exception.MonadThrow m, MonadWalk.MonadWalk m) =>
  FilePath ->
  ByteString.ByteString ->
  m ByteString.ByteString
format :: forall (m :: * -> *).
(MonadThrow m, MonadWalk m) =>
String -> ByteString -> m ByteString
format String
filePath ByteString
input = do
  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 = [Field Position] -> CabalSpecVersion
forall a. [Field a] -> CabalSpecVersion
GetCabalVersion.fromFields [Field Position]
fields
      comments = ByteString -> [Comment Position]
ExtractComments.fromByteString ByteString
input
  ( StripBlanks.run
      Monad.>=> AttachComments.run
      Monad.>=> ReflowText.run csv
      Monad.>=> EvaluatePragmas.run filePath
      Monad.>=> FormatFields.run csv
      Monad.>=> Render.run csv
    )
    (fields, comments)

-- | Returns true if the output is formatted correctly, false otherwise.
check ::
  Leniency.Leniency ->
  ByteString.ByteString ->
  ByteString.ByteString ->
  Bool
check :: Leniency -> ByteString -> ByteString -> Bool
check Leniency
leniency ByteString
input ByteString
output = case Leniency
leniency of
  Leniency
Leniency.Lenient ->
    let lf :: ByteString
lf = Word8 -> ByteString
ByteString.singleton Word8
0x0a
        crlf :: ByteString
crlf = Word8 -> ByteString -> ByteString
ByteString.cons Word8
0x0d ByteString
lf
     in ByteString
output ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString -> ByteString -> ByteString
ByteString.replace ByteString
crlf ByteString
lf ByteString
input
  Leniency
Leniency.Strict -> ByteString
output ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
input