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.Extra.ByteString as ByteString
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.Leniency as Leniency
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 Distribution.Fields as Fields
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]
arguments <- IO [String]
Environment.getArgs
[String] -> IO ()
forall (m :: * -> *).
(MonadLog m, MonadRead m, MonadThrow m, MonadWalk m,
MonadWrite m) =>
[String] -> m ()
mainWith [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] ->
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
ByteString
input <- Input -> m ByteString
forall (m :: * -> *). MonadRead m => Input -> m ByteString
MonadRead.read (Input -> m ByteString) -> Input -> m ByteString
forall a b. (a -> b) -> a -> b
$ Context -> Input
Context.input Context
context
ByteString
output <- String -> ByteString -> m ByteString
forall (m :: * -> *).
(MonadThrow m, MonadWalk m) =>
String -> ByteString -> m ByteString
format (Context -> String
Context.stdin Context
context) ByteString
input
case Context -> Mode
Context.mode Context
context of
Mode
Mode.Check -> do
let formatted :: Bool
formatted = case Context -> Leniency
Context.crlf Context
context 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
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 -> Output -> ByteString -> m ()
forall (m :: * -> *). MonadWrite m => Output -> ByteString -> m ()
MonadWrite.write (Context -> Output
Context.output Context
context) ByteString
output
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
[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
( ([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
filePath
(([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)