module Omnifmt.Pipes (
Status(..),
omnifmt,
select, checkFileSupported, checkFileExists, runProgram, checkFilePretty, commit, diff,
printFileStatus,
) where
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.Logger
import Control.Monad.Reader
import Data.List.Extra (lower)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Tuple.Extra (fst3)
import Omnifmt.Config
import Omnifmt.Process
import Pipes
import qualified Pipes.Prelude as Pipes
import System.Directory.Extra
import System.Exit
import System.FilePath
data Status = Unknown
| Error
| Unsupported
| NotFound
| Timeout
| Pretty
| Ugly
| Prettified
deriving (Eq, Show)
omnifmt :: FilePath -> FilePath -> (Status, FilePath, FilePath)
omnifmt = (Unknown,,)
select :: Monad m => [Status] -> ((Status, FilePath, FilePath) -> m (Status, FilePath, FilePath)) -> Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()
select states action = Pipes.mapM (\item -> if fst3 item `elem` states then action item else return item)
checkFileSupported :: MonadReader Config m => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()
checkFileSupported = select [Unknown] $ \item@(_, uglyFilePath, prettyFilePath) ->
ask >>= \config -> if supported config . T.toLower . T.pack . drop 1 $ takeExtension uglyFilePath
then return item
else return (Unsupported, uglyFilePath, prettyFilePath)
checkFileExists :: MonadIO m => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()
checkFileExists = select [Unknown] $ \item@(_, uglyFilePath, prettyFilePath) ->
ifM (liftIO $ doesFileExist uglyFilePath)
(return item)
(return (NotFound, uglyFilePath, prettyFilePath))
runProgram :: (MonadIO m, MonadLogger m, MonadReader Config m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()
runProgram = select [Unknown] $ \item@(_, uglyFilePath, prettyFilePath) -> do
config <- ask
let program = unsafeProgramFor config (T.pack . drop 1 $ takeExtension uglyFilePath)
(exitCode, _, stderr) <- runTimedCommand 5 . T.unpack $ substitute (T.concat [command program, inputSuffix program, outputSuffix program]) [
(inputVariableName, T.pack uglyFilePath),
(outputVariableName, T.pack prettyFilePath)
]
case exitCode of
ExitSuccess -> return item
ExitFailure 124 -> return (Timeout, uglyFilePath, prettyFilePath)
ExitFailure 137 -> return (Timeout, uglyFilePath, prettyFilePath)
_ -> logDebugN (T.pack stderr) >>
return (Error, uglyFilePath, prettyFilePath)
where
inputSuffix program
| usesInputVariable (command program) = T.empty
| otherwise = T.pack " < " `T.append` inputVariableName
outputSuffix program
| usesOutputVariable (command program) = T.empty
| otherwise = T.pack " > " `T.append` outputVariableName
checkFilePretty :: (MonadIO m, MonadLogger m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()
checkFilePretty = select [Unknown] $ \(_, uglyFilePath, prettyFilePath) -> do
(exitCode, _, stderr) <- runProcess "diff" [uglyFilePath, prettyFilePath]
case exitCode of
ExitFailure 1 -> return (Ugly, uglyFilePath, prettyFilePath)
ExitSuccess -> return (Pretty, uglyFilePath, prettyFilePath)
_ -> logDebugN (T.pack stderr) >>
return (Error, uglyFilePath, prettyFilePath)
commit :: MonadIO m => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()
commit = select [Ugly] $ \(_, uglyFilePath, prettyFilePath) -> do
liftIO $ renameFile prettyFilePath uglyFilePath
return (Prettified, uglyFilePath, prettyFilePath)
diff :: (MonadIO m, MonadLogger m) => Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()
diff = select [Ugly] $ \item@(_, uglyFilePath, prettyFilePath) -> do
(_, stdout, _) <- runProcess "git" ["diff", "--no-index", "--", uglyFilePath, prettyFilePath]
liftIO $ putStr stdout
return item
printFileStatus :: MonadLogger m => (Status -> Text -> m ()) -> Pipe (Status, FilePath, FilePath) (Status, FilePath, FilePath) m ()
printFileStatus f = Pipes.mapM_ $ \(status, uglyFilePath, _) ->
f status (T.pack $ uglyFilePath ++ ": " ++ showStatus status)
where
showStatus NotFound = "not found"
showStatus status = lower $ show status