{-# LANGUAGE OverloadedStrings #-}

-- |
-- Description : Ormolu formatter.
--
-- Applies the Ormolu formatter.
module Formatters.Ormolu (formatter) where

import qualified Data.Text as Text
import qualified Data.Text.Short as ShortText
import Formatter (FileContent, Formatter, FormattingResult)
import qualified Formatter
import qualified Ormolu
import Path (File, Path, Rel)
import qualified Path
import PathFilter (PathFilter)
import qualified PathFilter
import qualified System.IO.Unsafe (unsafePerformIO)
import qualified UnliftIO

-- | Ormolu 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
pfHs Path Rel File
path of
    PathAccept
PathFilter.Reject -> FormattingDirective
Formatter.DoNotFormat
    PathAccept
PathFilter.Accept ->
      (FileContent -> FormattingResult FileContent)
-> FormattingDirective
Formatter.Format ((FileContent -> FormattingResult FileContent)
 -> FormattingDirective)
-> (FileContent -> FormattingResult FileContent)
-> FormattingDirective
forall a b. (a -> b) -> a -> b
$ Config RegionIndices
-> Path Rel File -> FileContent -> FormattingResult FileContent
formatAction Config RegionIndices
Ormolu.defaultConfig Path Rel File
path

-- | Formatting action; defers to a 'System.IO.Unsafe.unsafePerformIO' action.
formatAction ::
  Ormolu.Config Ormolu.RegionIndices ->
  Path Rel File ->
  FileContent ->
  FormattingResult FileContent
formatAction :: Config RegionIndices
-> Path Rel File -> FileContent -> FormattingResult FileContent
formatAction Config RegionIndices
config Path Rel File
filePathForMessages 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
$
    Config RegionIndices
-> Path Rel File
-> FileContent
-> IO (FormattingResult FileContent)
formatActionIO Config RegionIndices
config Path Rel File
filePathForMessages FileContent
content

-- | Formatting action in 'IO'.
formatActionIO ::
  Ormolu.Config Ormolu.RegionIndices ->
  Path Rel File ->
  FileContent ->
  IO (FormattingResult FileContent)
formatActionIO :: Config RegionIndices
-> Path Rel File
-> FileContent
-> IO (FormattingResult FileContent)
formatActionIO Config RegionIndices
config Path Rel File
filePathForMessages FileContent
content = do
  case FileContent -> Maybe (Path Rel File) -> Either ErrorMessage Text
Formatter.fileContentToUtf8 FileContent
content (Path Rel File -> Maybe (Path Rel File)
forall a. a -> Maybe a
Just Path Rel File
filePathForMessages) of
    Left ErrorMessage
errorMessage -> 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
$ ErrorMessage -> FormattingResult FileContent
forall a. ErrorMessage -> FormattingResult a
Formatter.Error ErrorMessage
errorMessage
    Right Text
txtContent -> do
      let strContent :: String
strContent = Text -> String
Text.unpack Text
txtContent
          strFileName :: String
strFileName = Path Rel File -> String
Path.fromRelFile Path Rel File
filePathForMessages

          fmtAction :: IO FileContent
          fmtAction :: IO FileContent
fmtAction =
            Text -> FileContent
Formatter.utf8TextToFileContent
              (Text -> FileContent) -> IO Text -> IO FileContent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config RegionIndices -> String -> String -> IO Text
forall (m :: * -> *).
MonadIO m =>
Config RegionIndices -> String -> String -> m Text
Ormolu.ormolu Config RegionIndices
config String
strFileName String
strContent

          recovery :: Ormolu.OrmoluException -> IO (FormattingResult FileContent)
          recovery :: OrmoluException -> IO (FormattingResult FileContent)
recovery OrmoluException
e =
            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
"hspretty: Ormolu error when formatting file \""
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Path Rel File -> String
Path.fromRelFile Path Rel File
filePathForMessages
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\": "
                String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OrmoluException -> String
forall e. Exception e => e -> String
UnliftIO.displayException OrmoluException
e

      Either (FormattingResult FileContent) FileContent
result <- IO (Either (FormattingResult FileContent) FileContent)
-> (OrmoluException
    -> IO (Either (FormattingResult FileContent) FileContent))
-> IO (Either (FormattingResult FileContent) FileContent)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
UnliftIO.catch (FileContent -> Either (FormattingResult FileContent) FileContent
forall a b. b -> Either a b
Right (FileContent -> Either (FormattingResult FileContent) FileContent)
-> IO FileContent
-> IO (Either (FormattingResult FileContent) FileContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FileContent
fmtAction) ((FormattingResult FileContent
 -> Either (FormattingResult FileContent) FileContent)
-> IO (FormattingResult FileContent)
-> IO (Either (FormattingResult FileContent) FileContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FormattingResult FileContent
-> Either (FormattingResult FileContent) FileContent
forall a b. a -> Either a b
Left (IO (FormattingResult FileContent)
 -> IO (Either (FormattingResult FileContent) FileContent))
-> (OrmoluException -> IO (FormattingResult FileContent))
-> OrmoluException
-> IO (Either (FormattingResult FileContent) FileContent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrmoluException -> IO (FormattingResult FileContent)
recovery)

      case Either (FormattingResult FileContent) FileContent
result of
        Left FormattingResult FileContent
err -> FormattingResult FileContent -> IO (FormattingResult FileContent)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FormattingResult FileContent
err
        Right FileContent
outFileContent ->
          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
outFileContent 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
outFileContent

-- | A 'PathFilter' for @.hs@ files.
pfHs :: PathFilter
pfHs :: PathFilter
pfHs = ShortText -> PathFilter
PathFilter.pfExtension ShortText
".hs"