module Hix.OutputWriter where import qualified Data.ByteString as ByteString import qualified Data.Text.IO as Text import Exon (exon) import Path (Abs, File, Path, toFilePath) import qualified Hix.Console as Console import Hix.Data.Monad (M) import Hix.Data.OutputTarget (OutputTarget (..)) import Hix.Error (Error (Fatal), pathText) import Hix.Monad (throwM, tryIOMWithM) data WriteError = WriteError { WriteError -> Text msg :: Text, WriteError -> Path Abs File file :: Path Abs File } deriving stock (WriteError -> WriteError -> Bool (WriteError -> WriteError -> Bool) -> (WriteError -> WriteError -> Bool) -> Eq WriteError forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: WriteError -> WriteError -> Bool == :: WriteError -> WriteError -> Bool $c/= :: WriteError -> WriteError -> Bool /= :: WriteError -> WriteError -> Bool Eq, Int -> WriteError -> ShowS [WriteError] -> ShowS WriteError -> String (Int -> WriteError -> ShowS) -> (WriteError -> String) -> ([WriteError] -> ShowS) -> Show WriteError forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> WriteError -> ShowS showsPrec :: Int -> WriteError -> ShowS $cshow :: WriteError -> String show :: WriteError -> String $cshowList :: [WriteError] -> ShowS showList :: [WriteError] -> ShowS Show, (forall x. WriteError -> Rep WriteError x) -> (forall x. Rep WriteError x -> WriteError) -> Generic WriteError forall x. Rep WriteError x -> WriteError forall x. WriteError -> Rep WriteError x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cfrom :: forall x. WriteError -> Rep WriteError x from :: forall x. WriteError -> Rep WriteError x $cto :: forall x. Rep WriteError x -> WriteError to :: forall x. Rep WriteError x -> WriteError Generic) data OutputWriter = OutputWriter { OutputWriter -> ByteString -> M () bytes :: ByteString -> M (), OutputWriter -> Text -> M () text :: Text -> M (), OutputWriter -> Text -> M () textAppend :: Text -> M () } fileWriter :: (WriteError -> M ()) -> Path Abs File -> OutputWriter fileWriter :: (WriteError -> M ()) -> Path Abs File -> OutputWriter fileWriter WriteError -> M () errorHandler Path Abs File file = OutputWriter { bytes :: ByteString -> M () bytes = IO () -> M () handleError (IO () -> M ()) -> (ByteString -> IO ()) -> ByteString -> M () forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ByteString -> IO () ByteString.writeFile String fp, text :: Text -> M () text = IO () -> M () handleError (IO () -> M ()) -> (Text -> IO ()) -> Text -> M () forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text -> IO () Text.writeFile String fp, textAppend :: Text -> M () textAppend = IO () -> M () handleError (IO () -> M ()) -> (Text -> IO ()) -> Text -> M () forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text -> IO () Text.appendFile String fp } where handleError :: IO () -> M () handleError = (Text -> M ()) -> IO () -> M () forall a. (Text -> M a) -> IO a -> M a tryIOMWithM \ Text err -> WriteError -> M () errorHandler WriteError {msg :: Text msg = Text -> Text forall b a. (Show a, IsString b) => a -> b show Text err, Path Abs File file :: Path Abs File file :: Path Abs File file} fp :: String fp = Path Abs File -> String forall b t. Path b t -> String toFilePath Path Abs File file writeError :: WriteError -> M () writeError :: WriteError -> M () writeError WriteError err = Error -> M () forall a. Error -> M a throwM (Text -> Error Fatal [exon|Couldn't write to #{pathText err.file}: #{err.msg}|]) stdoutWriter :: OutputWriter stdoutWriter :: OutputWriter stdoutWriter = OutputWriter { bytes :: ByteString -> M () bytes = ByteString -> M () forall (m :: * -> *). MonadIO m => ByteString -> m () Console.bytesOut, text :: Text -> M () text = Text -> M () forall (m :: * -> *). MonadIO m => Text -> m () Console.out, textAppend :: Text -> M () textAppend = Text -> M () forall (m :: * -> *). MonadIO m => Text -> m () Console.out } outputWriterM :: M OutputWriter -> OutputTarget -> M OutputWriter outputWriterM :: M OutputWriter -> OutputTarget -> M OutputWriter outputWriterM M OutputWriter defaultWriter = \case OutputFile Path Abs File file -> OutputWriter -> M OutputWriter forall a. a -> M a forall (f :: * -> *) a. Applicative f => a -> f a pure ((WriteError -> M ()) -> Path Abs File -> OutputWriter fileWriter WriteError -> M () writeError Path Abs File file) OutputTarget OutputStdout -> OutputWriter -> M OutputWriter forall a. a -> M a forall (f :: * -> *) a. Applicative f => a -> f a pure OutputWriter stdoutWriter OutputTarget OutputDefault -> M OutputWriter defaultWriter outputWriter :: OutputWriter -> OutputTarget -> OutputWriter outputWriter :: OutputWriter -> OutputTarget -> OutputWriter outputWriter OutputWriter defaultWriter = \case OutputFile Path Abs File file -> (WriteError -> M ()) -> Path Abs File -> OutputWriter fileWriter WriteError -> M () writeError Path Abs File file OutputTarget OutputStdout -> OutputWriter stdoutWriter OutputTarget OutputDefault -> OutputWriter defaultWriter outputWriterGlobal :: OutputTarget -> OutputWriter outputWriterGlobal :: OutputTarget -> OutputWriter outputWriterGlobal = OutputWriter -> OutputTarget -> OutputWriter outputWriter OutputWriter stdoutWriter