{-# LANGUAGE OverloadedStrings #-}

-- |
-- Description : @cabal-fmt@ formatter.
--
-- Applies the @cabal-fmt@ formatter.
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

-- | cabal-fmt formatter.
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

-- | Formatting action; defers to a 'System.IO.Unsafe.unsafePerformIO' action.
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

-- | Formatting action in 'IO'.
formatActionIO :: FileContent -> IO (FormattingResult FileContent)
formatActionIO :: FileContent -> IO (FormattingResult FileContent)
formatActionIO FileContent
content = do
  -- check that we have the cabal-fmt utility installed first
  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
      -- create a temp file for the cabal file that must be formatted and
      --  invoke cabal-fmt on that
      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

-- | Check for the @cabal-fmt@ executable, producing an error message if it is
--   not installed.
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
$ ()

-- | A 'PathFilter' for @.cabal@ files.
pfCabal :: PathFilter
pfCabal :: PathFilter
pfCabal = ShortText -> PathFilter
PathFilter.pfExtension ShortText
".cabal"