module CabalGild.Main where

import qualified CabalGild.Action.AttachComments as AttachComments
import qualified CabalGild.Action.Discover as Discover
import qualified CabalGild.Action.ExtractComments as ExtractComments
import qualified CabalGild.Action.Format as Format
import qualified CabalGild.Action.GetCabalVersion as GetCabalVersion
import qualified CabalGild.Action.Reindent as Reindent
import qualified CabalGild.Action.RemovePositions as RemovePositions
import qualified CabalGild.Action.Render as Render
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.Flag as Flag
import qualified CabalGild.Type.Mode as Mode
import qualified Control.Monad as Monad
import qualified Control.Monad.Catch as Exception
import qualified Data.Maybe as Maybe
import qualified Data.Version as Version
import qualified Distribution.Fields as Fields
import qualified Paths_cabal_gild as This
import qualified System.Console.GetOpt as GetOpt
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import qualified System.IO as IO

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
name <- IO String
Environment.getProgName
  [String]
arguments <- IO [String]
Environment.getArgs
  String -> [String] -> IO ()
forall (m :: * -> *).
(MonadLog m, MonadRead m, MonadThrow m, MonadWalk m,
 MonadWrite m) =>
String -> [String] -> m ()
mainWith String
name [String]
arguments

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

mainWith ::
  ( MonadLog.MonadLog m,
    MonadRead.MonadRead m,
    Exception.MonadThrow m,
    MonadWalk.MonadWalk m,
    MonadWrite.MonadWrite m
  ) =>
  String ->
  [String] ->
  m ()
mainWith :: forall (m :: * -> *).
(MonadLog m, MonadRead m, MonadThrow m, MonadWalk m,
 MonadWrite m) =>
String -> [String] -> m ()
mainWith String
name [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
  let version :: String
version = Version -> String
Version.showVersion Version
This.version

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Config -> Bool
Config.help Config
config) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let header :: String
header =
          [String] -> String
unlines
            [ String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" version " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
version,
              String
"",
              String
"<https://github.com/tfausak/cabal-gild>"
            ]
    String -> m ()
forall (m :: * -> *). MonadLog m => String -> m ()
MonadLog.log (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> [OptDescr Flag] -> String
forall a. String -> [OptDescr a] -> String
GetOpt.usageInfo String
header [OptDescr Flag]
Flag.options
    ExitCode -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM ExitCode
Exit.ExitSuccess

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (Config -> Bool
Config.version Config
config) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    String -> m ()
forall (m :: * -> *). MonadLog m => String -> m ()
MonadLog.logLn String
version
    ExitCode -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM ExitCode
Exit.ExitSuccess

  ByteString
input <- Maybe String -> m ByteString
forall (m :: * -> *). MonadRead m => Maybe String -> m ByteString
MonadRead.read (Maybe String -> m ByteString) -> Maybe String -> m ByteString
forall a b. (a -> b) -> a -> b
$ Config -> Maybe String
Config.input Config
config
  [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
  ByteString
output <-
    ( ([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)
Reindent.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.
(MonadThrow m, MonadWalk m) =>
String -> ([Field [Comment a]], cs) -> m ([Field [Comment a]], cs)
Discover.run (String -> Maybe String -> String
forall a. a -> Maybe a -> a
Maybe.fromMaybe (Config -> String
Config.stdin Config
config) (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Config -> Maybe String
Config.input Config
config)
        (([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)
Format.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 Config -> Mode
Config.mode Config
config of
    Mode
Mode.Check ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (ByteString
output ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
input) (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 -> Maybe String -> ByteString -> m ()
forall (m :: * -> *).
MonadWrite m =>
Maybe String -> ByteString -> m ()
MonadWrite.write (Config -> Maybe String
Config.output Config
config) ByteString
output