{-# LANGUAGE OverloadedStrings #-}
module Formatters.CabalFmt where
import qualified Data.Text.Short as ShortText
import Formatter (ErrorMessage, FileContent, Formatter, FormattingResult)
import qualified Formatter
import qualified Path
import qualified Path.IO
import PathFilter (PathFilter)
import qualified PathFilter
import qualified System.Directory
import qualified System.Exit
import qualified System.IO.Unsafe (unsafePerformIO)
import qualified System.Process
import qualified UnliftIO.IO
formatter :: Formatter
formatter :: Formatter
formatter = (Path Rel File -> FormattingDirective) -> Formatter
Formatter.Formatter ((Path Rel File -> FormattingDirective) -> Formatter)
-> (Path Rel File -> FormattingDirective) -> Formatter
forall a b. (a -> b) -> a -> b
$ \Path Rel File
path ->
case PathFilter -> Path Rel File -> PathAccept
PathFilter.unPathFilter PathFilter
pfCabal Path Rel File
path of
PathAccept
PathFilter.Reject -> FormattingDirective
Formatter.DoNotFormat
PathAccept
PathFilter.Accept -> (FileContent -> FormattingResult FileContent)
-> FormattingDirective
Formatter.Format FileContent -> FormattingResult FileContent
formatAction
formatAction :: FileContent -> FormattingResult FileContent
formatAction :: FileContent -> FormattingResult FileContent
formatAction FileContent
content = IO (FormattingResult FileContent) -> FormattingResult FileContent
forall a. IO a -> a
System.IO.Unsafe.unsafePerformIO (IO (FormattingResult FileContent) -> FormattingResult FileContent)
-> IO (FormattingResult FileContent)
-> FormattingResult FileContent
forall a b. (a -> b) -> a -> b
$ FileContent -> IO (FormattingResult FileContent)
formatActionIO FileContent
content
formatActionIO :: FileContent -> IO (FormattingResult FileContent)
formatActionIO :: FileContent -> IO (FormattingResult FileContent)
formatActionIO FileContent
content = do
Either ErrorMessage ()
cabalFmtCheck <- IO (Either ErrorMessage ())
checkForCabalFmt
case Either ErrorMessage ()
cabalFmtCheck of
Left ErrorMessage
err -> FormattingResult FileContent -> IO (FormattingResult FileContent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormattingResult FileContent -> IO (FormattingResult FileContent))
-> (ErrorMessage -> FormattingResult FileContent)
-> ErrorMessage
-> IO (FormattingResult FileContent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> FormattingResult FileContent
forall a. ErrorMessage -> FormattingResult a
Formatter.Error (ErrorMessage -> IO (FormattingResult FileContent))
-> ErrorMessage -> IO (FormattingResult FileContent)
forall a b. (a -> b) -> a -> b
$ ErrorMessage
err
Right () -> do
String
-> (Path Abs File -> Handle -> IO (FormattingResult FileContent))
-> IO (FormattingResult FileContent)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (Path Abs File -> Handle -> m a) -> m a
Path.IO.withSystemTempFile String
".cabal" ((Path Abs File -> Handle -> IO (FormattingResult FileContent))
-> IO (FormattingResult FileContent))
-> (Path Abs File -> Handle -> IO (FormattingResult FileContent))
-> IO (FormattingResult FileContent)
forall a b. (a -> b) -> a -> b
$
\Path Abs File
tempFile Handle
handle -> do
Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
UnliftIO.IO.hClose Handle
handle
Either ErrorMessage ()
writeResult <- Path Abs File -> FileContent -> IO (Either ErrorMessage ())
Formatter.writeAbsoluteFile Path Abs File
tempFile FileContent
content
case Either ErrorMessage ()
writeResult of
Left ErrorMessage
errorMessage -> FormattingResult FileContent -> IO (FormattingResult FileContent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormattingResult FileContent -> IO (FormattingResult FileContent))
-> (ErrorMessage -> FormattingResult FileContent)
-> ErrorMessage
-> IO (FormattingResult FileContent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> FormattingResult FileContent
forall a. ErrorMessage -> FormattingResult a
Formatter.Error (ErrorMessage -> IO (FormattingResult FileContent))
-> ErrorMessage -> IO (FormattingResult FileContent)
forall a b. (a -> b) -> a -> b
$ ErrorMessage
errorMessage
Right () -> do
let cp :: CreateProcess
cp =
String -> [String] -> CreateProcess
System.Process.proc
String
"cabal-fmt"
[String
"--inplace", Path Abs File -> String
Path.fromAbsFile Path Abs File
tempFile]
(ExitCode
exitCode, String
_, String
stderr) <-
CreateProcess -> String -> IO (ExitCode, String, String)
System.Process.readCreateProcessWithExitCode CreateProcess
cp String
""
case ExitCode
exitCode of
System.Exit.ExitFailure Int
_ ->
FormattingResult FileContent -> IO (FormattingResult FileContent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(FormattingResult FileContent -> IO (FormattingResult FileContent))
-> (String -> FormattingResult FileContent)
-> String
-> IO (FormattingResult FileContent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> FormattingResult FileContent
forall a. ErrorMessage -> FormattingResult a
Formatter.Error
(ErrorMessage -> FormattingResult FileContent)
-> (String -> ErrorMessage)
-> String
-> FormattingResult FileContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ErrorMessage
Formatter.ErrorMessage
(ShortText -> ErrorMessage)
-> (String -> ShortText) -> String -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShortText
ShortText.pack
(String -> IO (FormattingResult FileContent))
-> String -> IO (FormattingResult FileContent)
forall a b. (a -> b) -> a -> b
$ String
stderr
ExitCode
System.Exit.ExitSuccess -> do
Either ErrorMessage FileContent
readResult <- Path Abs File -> IO (Either ErrorMessage FileContent)
Formatter.readAbsoluteFile Path Abs File
tempFile
case Either ErrorMessage FileContent
readResult of
Left ErrorMessage
errorMessage -> FormattingResult FileContent -> IO (FormattingResult FileContent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormattingResult FileContent -> IO (FormattingResult FileContent))
-> (ErrorMessage -> FormattingResult FileContent)
-> ErrorMessage
-> IO (FormattingResult FileContent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> FormattingResult FileContent
forall a. ErrorMessage -> FormattingResult a
Formatter.Error (ErrorMessage -> IO (FormattingResult FileContent))
-> ErrorMessage -> IO (FormattingResult FileContent)
forall a b. (a -> b) -> a -> b
$ ErrorMessage
errorMessage
Right FileContent
outContent ->
FormattingResult FileContent -> IO (FormattingResult FileContent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FormattingResult FileContent -> IO (FormattingResult FileContent))
-> FormattingResult FileContent
-> IO (FormattingResult FileContent)
forall a b. (a -> b) -> a -> b
$
if FileContent
outContent FileContent -> FileContent -> Bool
forall a. Eq a => a -> a -> Bool
== FileContent
content
then FormattingResult FileContent
forall a. FormattingResult a
Formatter.Unchanged
else FileContent -> FormattingResult FileContent
forall a. a -> FormattingResult a
Formatter.Changed FileContent
outContent
checkForCabalFmt :: IO (Either ErrorMessage ())
checkForCabalFmt :: IO (Either ErrorMessage ())
checkForCabalFmt = do
Maybe String
exe <- String -> IO (Maybe String)
System.Directory.findExecutable String
"cabal-fmt"
case Maybe String
exe of
Maybe String
Nothing ->
Either ErrorMessage () -> IO (Either ErrorMessage ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ErrorMessage () -> IO (Either ErrorMessage ()))
-> (ShortText -> Either ErrorMessage ())
-> ShortText
-> IO (Either ErrorMessage ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Either ErrorMessage ()
forall a b. a -> Either a b
Left (ErrorMessage -> Either ErrorMessage ())
-> (ShortText -> ErrorMessage)
-> ShortText
-> Either ErrorMessage ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ErrorMessage
Formatter.ErrorMessage (ShortText -> IO (Either ErrorMessage ()))
-> ShortText -> IO (Either ErrorMessage ())
forall a b. (a -> b) -> a -> b
$
ShortText
"Could not find executable \"cabal-fmt\"; please make sure it is "
ShortText -> ShortText -> ShortText
forall a. Semigroup a => a -> a -> a
<> ShortText
"available on the path."
Just String
_ -> Either ErrorMessage () -> IO (Either ErrorMessage ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ErrorMessage () -> IO (Either ErrorMessage ()))
-> (() -> Either ErrorMessage ())
-> ()
-> IO (Either ErrorMessage ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either ErrorMessage ()
forall a b. b -> Either a b
Right (() -> IO (Either ErrorMessage ()))
-> () -> IO (Either ErrorMessage ())
forall a b. (a -> b) -> a -> b
$ ()
pfCabal :: PathFilter
pfCabal :: PathFilter
pfCabal = ShortText -> PathFilter
PathFilter.pfExtension ShortText
".cabal"