{-# LANGUAGE OverloadedStrings #-}
module Formatter
(
Formatter (..),
FormattingDirective (..),
FormattingResult (..),
FileContent (..),
ErrorMessage (..),
runFormatIO,
readRelativeFile,
readAbsoluteFile,
writeRelativeFile,
writeAbsoluteFile,
isUnchanged,
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
newtype Formatter = Formatter
{
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
data FormattingDirective
=
DoNotFormat
|
Format (FileContent -> FormattingResult FileContent)
data FormattingResult a
=
NotFormatted
|
Unchanged
|
Changed !a
|
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)
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
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)
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)
runFormatIO ::
RunMode ->
Formatter ->
Path Abs Dir ->
Path Rel File ->
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 ())
readRelativeFile ::
Path Abs Dir ->
Path Rel File ->
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)
readAbsoluteFile ::
Path Abs File ->
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
writeRelativeFile ::
Path Abs Dir ->
Path Rel File ->
FileContent ->
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)
writeAbsoluteFile ::
Path Abs File ->
FileContent ->
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
fileContentToUtf8 ::
FileContent ->
Maybe (Path Rel File) ->
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
utf8TextToFileContent ::
Text ->
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