{-# LANGUAGE OverloadedStrings #-}

-- |
-- Description : Formatter types and operations.
--
-- 'Formatter' is a (potential) formatter for a file. It contains a method,
-- 'runFormat', which takes a relative path to a file and, by inspecting the
-- path alone, must decide whether to format the file or not. To specify if the
-- file will be formatted by that formatter, it returns a 'FormattingDirective'.
--
-- If the 'FormattingDirective' is 'Format' then that constructor supplies a
-- function which can take the 'FileContent', and return a 'FormattingResult'.
-- In turn, the 'FormattingResult' specifies the result of formatting.
--
-- To implement a new 'Formatter', return a new 'Formatter' instance, which
-- inspects the file path and, if the file can be formatted by that 'Formatter',
-- return a 'Format' constructor containing the formatting operation.
--
-- All aspects of the 'Formatter' operation are pure or "effectively pure". If
-- 'IO' operations are required, they should be implemented in
-- 'System.IO.Unsafe.unsafePerformIO' as effectively-pure operations.
module Formatter
  ( -- * Types

    -- ** Formatting
    Formatter (..),
    FormattingDirective (..),
    FormattingResult (..),

    -- ** Miscellaneous
    FileContent (..),
    ErrorMessage (..),

    -- * IO Actions
    runFormatIO,
    readRelativeFile,
    readAbsoluteFile,
    writeRelativeFile,
    writeAbsoluteFile,

    -- * Functions

    -- ** Tests
    isUnchanged,

    -- ** Conversions
    fileContentToUtf8,
    utf8TextToFileContent,
  )
where

import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import Data.Text (Text)
import qualified Data.Text.Encoding as Encoding
import Data.Text.Short (ShortText)
import qualified Data.Text.Short as ShortText
import Path (Abs, Dir, File, Path, Rel, (</>))
import qualified Path
import RunMode (RunMode)
import qualified RunMode
import UnliftIO (IOException)
import qualified UnliftIO

-- | Formatter.
newtype Formatter = Formatter
  { -- | Run the formatter.
    --
    -- This accepts a relative path to a file and returns a formatting
    -- directive for that file. This is a pure function: it can only inspect
    -- the name of the file, it should NOT try to perform any IO.
    Formatter -> Path Rel File -> FormattingDirective
runFormat :: Path Rel File -> FormattingDirective
  }

instance Semigroup Formatter where
  Formatter
f1 <> :: Formatter -> Formatter -> Formatter
<> Formatter
f2 = (Path Rel File -> FormattingDirective) -> Formatter
Formatter ((Path Rel File -> FormattingDirective) -> Formatter)
-> (Path Rel File -> FormattingDirective) -> Formatter
forall a b. (a -> b) -> a -> b
$ \Path Rel File
path ->
    case Formatter -> Path Rel File -> FormattingDirective
runFormat Formatter
f1 Path Rel File
path of
      FormattingDirective
DoNotFormat -> Formatter -> Path Rel File -> FormattingDirective
runFormat Formatter
f2 Path Rel File
path
      Format FileContent -> FormattingResult FileContent
g1 ->
        case Formatter -> Path Rel File -> FormattingDirective
runFormat Formatter
f2 Path Rel File
path of
          FormattingDirective
DoNotFormat -> (FileContent -> FormattingResult FileContent)
-> FormattingDirective
Format FileContent -> FormattingResult FileContent
g1
          Format FileContent -> FormattingResult FileContent
g2 -> (FileContent -> FormattingResult FileContent)
-> FormattingDirective
Format ((FileContent -> FormattingResult FileContent)
-> (FileContent -> FormattingResult FileContent)
-> FileContent
-> FormattingResult FileContent
sequenceFmtFns FileContent -> FormattingResult FileContent
g1 FileContent -> FormattingResult FileContent
g2)
    where
      sequenceFmtFns ::
        (FileContent -> FormattingResult FileContent) ->
        (FileContent -> FormattingResult FileContent) ->
        (FileContent -> FormattingResult FileContent)
      sequenceFmtFns :: (FileContent -> FormattingResult FileContent)
-> (FileContent -> FormattingResult FileContent)
-> FileContent
-> FormattingResult FileContent
sequenceFmtFns FileContent -> FormattingResult FileContent
a FileContent -> FormattingResult FileContent
b = \FileContent
content ->
        case FileContent -> FormattingResult FileContent
a FileContent
content of
          FormattingResult FileContent
NotFormatted -> FileContent -> FormattingResult FileContent
b FileContent
content
          FormattingResult FileContent
Unchanged -> FileContent -> FormattingResult FileContent
b FileContent
content
          Changed FileContent
content' -> FileContent -> FormattingResult FileContent
b FileContent
content'
          Error ErrorMessage
message -> ErrorMessage -> FormattingResult FileContent
forall a. ErrorMessage -> FormattingResult a
Error ErrorMessage
message

instance Monoid Formatter where
  mempty :: Formatter
mempty = (Path Rel File -> FormattingDirective) -> Formatter
Formatter ((Path Rel File -> FormattingDirective) -> Formatter)
-> (Path Rel File -> FormattingDirective) -> Formatter
forall a b. (a -> b) -> a -> b
$ FormattingDirective -> Path Rel File -> FormattingDirective
forall a b. a -> b -> a
const FormattingDirective
DoNotFormat

-- | Formatting directive.
--
-- This indicates whether formatting can proceed or not.
data FormattingDirective
  = -- | Do not format the file any further.
    DoNotFormat
  | -- | Formatter, which, given the content of a file returns a formatting
    --   result.
    --
    -- This is a pure function. For some formatters, it may be necessary to run
    -- this action using 'System.IO.Unsafe.unsafePerformIO', but in that case,
    -- every effort should still be made to ensure it behaves as a pure
    -- function.
    Format (FileContent -> FormattingResult FileContent)

-- | Result of running a formatter.
--
-- The type parameter @a@ is the type of values returned when formatting has
-- changed.
data FormattingResult a
  = -- | The formatter decided not to format the file after inspecting it.
    NotFormatted
  | -- | Formatting completed successfully, without changes.
    Unchanged
  | -- | Formatting completed successfully, and there are new contents.
    Changed !a
  | -- | An error occurred while formatting.
    Error !ErrorMessage
  deriving (FormattingResult a -> FormattingResult a -> Bool
(FormattingResult a -> FormattingResult a -> Bool)
-> (FormattingResult a -> FormattingResult a -> Bool)
-> Eq (FormattingResult a)
forall a. Eq a => FormattingResult a -> FormattingResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormattingResult a -> FormattingResult a -> Bool
$c/= :: forall a. Eq a => FormattingResult a -> FormattingResult a -> Bool
== :: FormattingResult a -> FormattingResult a -> Bool
$c== :: forall a. Eq a => FormattingResult a -> FormattingResult a -> Bool
Eq)

-- | Return 'True' if a 'FormattingResult' indicates definitively that a file
--   was unchanged after successful processing.
isUnchanged :: FormattingResult a -> Bool
isUnchanged :: FormattingResult a -> Bool
isUnchanged FormattingResult a
NotFormatted = Bool
True
isUnchanged FormattingResult a
Unchanged = Bool
True
isUnchanged FormattingResult a
_ = Bool
False

-- | Content of a file for formatting.
newtype FileContent = FileContent
  { FileContent -> ByteString
unFileContent :: ByteString
  }
  deriving (FileContent -> FileContent -> Bool
(FileContent -> FileContent -> Bool)
-> (FileContent -> FileContent -> Bool) -> Eq FileContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileContent -> FileContent -> Bool
$c/= :: FileContent -> FileContent -> Bool
== :: FileContent -> FileContent -> Bool
$c== :: FileContent -> FileContent -> Bool
Eq)

-- | Error message.
newtype ErrorMessage = ErrorMessage
  { ErrorMessage -> ShortText
unErrorMessage :: ShortText
  }
  deriving (ErrorMessage -> ErrorMessage -> Bool
(ErrorMessage -> ErrorMessage -> Bool)
-> (ErrorMessage -> ErrorMessage -> Bool) -> Eq ErrorMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorMessage -> ErrorMessage -> Bool
$c/= :: ErrorMessage -> ErrorMessage -> Bool
== :: ErrorMessage -> ErrorMessage -> Bool
$c== :: ErrorMessage -> ErrorMessage -> Bool
Eq)

-- | Run a formatter in IO on a single file.
--
-- This operation checks if the formatter can run on the provided file. If it
-- can run then the file is loaded, and the formatter is run. If the run mode is
-- 'RunMode.Format' then the new formatted output is written to the file,
-- otherwise the file is left as-is.
runFormatIO ::
  -- | Run mode: either we're only checking, or we're also formatting.
  RunMode ->
  -- | Formatter to run.
  Formatter ->
  -- | Parent / project directory.
  Path Abs Dir ->
  -- | Path to the file (relative to the above parent directory).
  Path Rel File ->
  -- | Formatting result (without capturing the formatted output).
  IO (FormattingResult ())
runFormatIO :: RunMode
-> Formatter
-> Path Abs Dir
-> Path Rel File
-> IO (FormattingResult ())
runFormatIO RunMode
runMode Formatter
formatter Path Abs Dir
parentDir Path Rel File
file =
  case Formatter -> Path Rel File -> FormattingDirective
runFormat Formatter
formatter Path Rel File
file of
    FormattingDirective
DoNotFormat -> FormattingResult () -> IO (FormattingResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormattingResult ()
forall a. FormattingResult a
NotFormatted
    Format FileContent -> FormattingResult FileContent
formatFn -> do
      Either ErrorMessage FileContent
readResult <- Path Abs Dir
-> Path Rel File -> IO (Either ErrorMessage FileContent)
readRelativeFile Path Abs Dir
parentDir Path Rel File
file
      case Either ErrorMessage FileContent
readResult of
        Left ErrorMessage
message -> FormattingResult () -> IO (FormattingResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorMessage -> FormattingResult ()
forall a. ErrorMessage -> FormattingResult a
Error ErrorMessage
message)
        Right FileContent
content ->
          case FileContent -> FormattingResult FileContent
formatFn FileContent
content of
            FormattingResult FileContent
NotFormatted -> FormattingResult () -> IO (FormattingResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormattingResult ()
forall a. FormattingResult a
NotFormatted
            FormattingResult FileContent
Unchanged -> FormattingResult () -> IO (FormattingResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormattingResult ()
forall a. FormattingResult a
Unchanged
            Error ErrorMessage
message -> FormattingResult () -> IO (FormattingResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorMessage -> FormattingResult ()
forall a. ErrorMessage -> FormattingResult a
Error ErrorMessage
message)
            Changed FileContent
newContent -> do
              case RunMode
runMode of
                RunMode
RunMode.CheckOnly -> FormattingResult () -> IO (FormattingResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> FormattingResult ()
forall a. a -> FormattingResult a
Changed ())
                RunMode
RunMode.Format -> do
                  Either ErrorMessage ()
writeResult <- Path Abs Dir
-> Path Rel File -> FileContent -> IO (Either ErrorMessage ())
writeRelativeFile Path Abs Dir
parentDir Path Rel File
file FileContent
newContent
                  case Either ErrorMessage ()
writeResult of
                    Left ErrorMessage
message -> FormattingResult () -> IO (FormattingResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ErrorMessage -> FormattingResult ()
forall a. ErrorMessage -> FormattingResult a
Error ErrorMessage
message)
                    Right () -> FormattingResult () -> IO (FormattingResult ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> FormattingResult ()
forall a. a -> FormattingResult a
Changed ())

-- | Read a relative file into 'FileContent'.
--
-- If the action is unsuccessful then an 'ErrorMessage' is returned.
readRelativeFile ::
  -- | Path to the parent directory of the file.
  Path Abs Dir ->
  -- | Path of the file relative to the parent directory.
  Path Rel File ->
  -- | IO action containing the file content.
  IO (Either ErrorMessage FileContent)
readRelativeFile :: Path Abs Dir
-> Path Rel File -> IO (Either ErrorMessage FileContent)
readRelativeFile Path Abs Dir
parentDir Path Rel File
file = Path Abs File -> IO (Either ErrorMessage FileContent)
readAbsoluteFile (Path Abs Dir
parentDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
file)

-- | Read an absolute file into 'FileContent'.
--
-- If the action is unsuccessful then an 'ErrorMessage' is returned.
readAbsoluteFile ::
  -- | Path of the file to write.
  Path Abs File ->
  -- | IO action.
  IO (Either ErrorMessage FileContent)
readAbsoluteFile :: Path Abs File -> IO (Either ErrorMessage FileContent)
readAbsoluteFile Path Abs File
file = IO (Either ErrorMessage FileContent)
-> (IOException -> IO (Either ErrorMessage FileContent))
-> IO (Either ErrorMessage FileContent)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (IOException -> m a) -> m a
UnliftIO.catchIO IO (Either ErrorMessage FileContent)
action IOException -> IO (Either ErrorMessage FileContent)
recover
  where
    path :: FilePath
    path :: FilePath
path = Path Abs File -> FilePath
forall b t. Path b t -> FilePath
Path.toFilePath Path Abs File
file

    action :: IO (Either ErrorMessage FileContent)
    action :: IO (Either ErrorMessage FileContent)
action = FileContent -> Either ErrorMessage FileContent
forall a b. b -> Either a b
Right (FileContent -> Either ErrorMessage FileContent)
-> (ByteString -> FileContent)
-> ByteString
-> Either ErrorMessage FileContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FileContent
FileContent (ByteString -> Either ErrorMessage FileContent)
-> IO ByteString -> IO (Either ErrorMessage FileContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
ByteString.readFile FilePath
path

    recover :: IOException -> IO (Either ErrorMessage FileContent)
    recover :: IOException -> IO (Either ErrorMessage FileContent)
recover IOException
ioe = Either ErrorMessage FileContent
-> IO (Either ErrorMessage FileContent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ErrorMessage FileContent
 -> IO (Either ErrorMessage FileContent))
-> (ShortText -> Either ErrorMessage FileContent)
-> ShortText
-> IO (Either ErrorMessage FileContent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorMessage -> Either ErrorMessage FileContent
forall a b. a -> Either a b
Left (ErrorMessage -> Either ErrorMessage FileContent)
-> (ShortText -> ErrorMessage)
-> ShortText
-> Either ErrorMessage FileContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ErrorMessage
ErrorMessage (ShortText -> IO (Either ErrorMessage FileContent))
-> ShortText -> IO (Either ErrorMessage FileContent)
forall a b. (a -> b) -> a -> b
$ ShortText
message
      where
        message :: ShortText
        message :: ShortText
message =
          FilePath -> ShortText
ShortText.pack (FilePath -> ShortText) -> FilePath -> ShortText
forall a b. (a -> b) -> a -> b
$
            FilePath
"hspretty: Error reading file \""
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\": "
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> IOException -> FilePath
forall e. Exception e => e -> FilePath
UnliftIO.displayException IOException
ioe

-- | Write a relative file from 'FileContent'.
--
-- If the action is unsuccessful then an 'ErrorMessage' is returned.
writeRelativeFile ::
  -- | Path of the parent directory of the file.
  Path Abs Dir ->
  -- | Path of the file relative to the parent directory.
  Path Rel File ->
  -- | Content of the file.
  FileContent ->
  -- | IO action that writes the file content.
  IO (Either ErrorMessage ())
writeRelativeFile :: Path Abs Dir
-> Path Rel File -> FileContent -> IO (Either ErrorMessage ())
writeRelativeFile Path Abs Dir
parentDir Path Rel File
file = Path Abs File -> FileContent -> IO (Either ErrorMessage ())
writeAbsoluteFile (Path Abs Dir
parentDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
file)

-- | Write an absolute file from 'FileContent'
--
-- If the action is unsuccessful then an 'ErrorMessage' is returned.
writeAbsoluteFile ::
  -- | Absolute path of the file to write.
  Path Abs File ->
  -- | Content of the file.
  FileContent ->
  -- | IO action.
  IO (Either ErrorMessage ())
writeAbsoluteFile :: Path Abs File -> FileContent -> IO (Either ErrorMessage ())
writeAbsoluteFile Path Abs File
file FileContent
content = IO (Either ErrorMessage ())
-> (IOException -> IO (Either ErrorMessage ()))
-> IO (Either ErrorMessage ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (IOException -> m a) -> m a
UnliftIO.catchIO IO (Either ErrorMessage ())
action IOException -> IO (Either ErrorMessage ())
recover
  where
    path :: FilePath
    path :: FilePath
path = Path Abs File -> FilePath
forall b t. Path b t -> FilePath
Path.toFilePath Path Abs File
file

    bs :: ByteString
    bs :: ByteString
bs = FileContent -> ByteString
unFileContent FileContent
content

    action :: IO (Either ErrorMessage ())
    action :: IO (Either ErrorMessage ())
action = FilePath -> ByteString -> IO ()
ByteString.writeFile FilePath
path ByteString
bs IO () -> IO (Either ErrorMessage ()) -> IO (Either ErrorMessage ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either ErrorMessage () -> IO (Either ErrorMessage ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either ErrorMessage ()
forall a b. b -> Either a b
Right ())

    recover :: IOException -> IO (Either ErrorMessage ())
    recover :: IOException -> IO (Either ErrorMessage ())
recover IOException
ioe = 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
ErrorMessage (ShortText -> IO (Either ErrorMessage ()))
-> ShortText -> IO (Either ErrorMessage ())
forall a b. (a -> b) -> a -> b
$ ShortText
message
      where
        message :: ShortText
        message :: ShortText
message =
          FilePath -> ShortText
ShortText.pack (FilePath -> ShortText) -> FilePath -> ShortText
forall a b. (a -> b) -> a -> b
$
            FilePath
"hspretty: Error writing file \""
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
path
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\": "
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> IOException -> FilePath
forall e. Exception e => e -> FilePath
UnliftIO.displayException IOException
ioe

-- | Convert 'FileContent' from an underlying 'ByteString' to UTF-8.
--
-- If this operation fails with a unicode error, the underlying exception is
-- converted to an 'ErrorMessage'.
fileContentToUtf8 ::
  -- | Content to convert to UTF-8.
  FileContent ->
  -- | Path to the relative file, if known (used for error messages).
  Maybe (Path Rel File) ->
  -- | Either an error message, or the file read as UTF-8 text.
  Either ErrorMessage Text
fileContentToUtf8 :: FileContent -> Maybe (Path Rel File) -> Either ErrorMessage Text
fileContentToUtf8 FileContent
fileContent Maybe (Path Rel File)
maybeFile =
  case ByteString -> Either UnicodeException Text
Encoding.decodeUtf8' (FileContent -> ByteString
unFileContent FileContent
fileContent) of
    Right Text
txt -> Text -> Either ErrorMessage Text
forall a b. b -> Either a b
Right Text
txt
    Left UnicodeException
unicodeException ->
      ErrorMessage -> Either ErrorMessage Text
forall a b. a -> Either a b
Left (ErrorMessage -> Either ErrorMessage Text)
-> (FilePath -> ErrorMessage)
-> FilePath
-> Either ErrorMessage Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ErrorMessage
ErrorMessage (ShortText -> ErrorMessage)
-> (FilePath -> ShortText) -> FilePath -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShortText
ShortText.pack (FilePath -> Either ErrorMessage Text)
-> FilePath -> Either ErrorMessage Text
forall a b. (a -> b) -> a -> b
$
        case Maybe (Path Rel File)
maybeFile of
          Maybe (Path Rel File)
Nothing ->
            FilePath
"hspretty: error decoding file contents as UTF-8: "
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> UnicodeException -> FilePath
forall e. Exception e => e -> FilePath
UnliftIO.displayException UnicodeException
unicodeException
          Just Path Rel File
file ->
            FilePath
"hspretty: error decoding file \""
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Path Rel File -> FilePath
Path.fromRelFile Path Rel File
file
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"\" as UTF-8: "
              FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> UnicodeException -> FilePath
forall e. Exception e => e -> FilePath
UnliftIO.displayException UnicodeException
unicodeException

-- | Encode 'Text' as 'FileContent' in UTF-8.
utf8TextToFileContent ::
  -- | Text to encode.
  Text ->
  -- | Text encoded as 'FileContent'.
  FileContent
utf8TextToFileContent :: Text -> FileContent
utf8TextToFileContent = ByteString -> FileContent
FileContent (ByteString -> FileContent)
-> (Text -> ByteString) -> Text -> FileContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Encoding.encodeUtf8