{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Program.Mighty.Report (
    Reporter,
    initReporter,
    report,
    reportDo,
    warpHandler,
    printStdout,
) where

#if __GLASGOW_HASKELL__ < 709
import Control.Applicative
#endif
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.UnixTime
import GHC.IO.Exception (IOErrorType (..))
import Network.Wai
import Network.Wai.Handler.Warp (InvalidRequest)
import System.IO
import System.IO.Error (ioeGetErrorType)
import System.Posix (getProcessID)
import UnliftIO.Exception

import Program.Mighty.ByteString

data Method = FileOnly | FileAndStdout deriving (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
/= :: Method -> Method -> Bool
Eq)
data Reporter = Reporter Method FilePath

initReporter :: Bool -> FilePath -> Reporter
initReporter :: Bool -> FilePath -> Reporter
initReporter Bool
debug FilePath
reportFile = Method -> FilePath -> Reporter
Reporter Method
method FilePath
reportFile
  where
    method :: Method
method
        | Bool
debug = Method
FileAndStdout
        | Bool
otherwise = Method
FileOnly

report :: Reporter -> ByteString -> IO ()
report :: Reporter -> Format -> IO ()
report (Reporter Method
method FilePath
reportFile) Format
msg = (SomeException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(SomeException e
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Format
pid <- FilePath -> Format
BS.pack (FilePath -> Format)
-> (ProcessID -> FilePath) -> ProcessID -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessID -> FilePath
forall a. Show a => a -> FilePath
show (ProcessID -> Format) -> IO ProcessID -> IO Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ProcessID
getProcessID
    Format
tm <- IO UnixTime
getUnixTime IO UnixTime -> (UnixTime -> IO Format) -> IO Format
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Format -> UnixTime -> IO Format
formatUnixTime Format
"%d %b %Y %H:%M:%S"
    let logmsg :: Format
logmsg = [Format] -> Format
BS.concat [Format
tm, Format
": pid = ", Format
pid, Format
": ", Format
msg, Format
"\n"]
    FilePath -> Format -> IO ()
BS.appendFile FilePath
reportFile Format
logmsg
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Method
method Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
FileAndStdout) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Format -> IO ()
BS.putStr Format
logmsg

----------------------------------------------------------------

reportDo :: Reporter -> IO () -> IO ()
reportDo :: Reporter -> IO () -> IO ()
reportDo Reporter
rpt IO ()
act = IO ()
act IO () -> (SomeException -> IO ()) -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` Reporter -> Maybe Request -> SomeException -> IO ()
warpHandler Reporter
rpt Maybe Request
forall a. Maybe a
Nothing

----------------------------------------------------------------

warpHandler :: Reporter -> Maybe Request -> SomeException -> IO ()
warpHandler :: Reporter -> Maybe Request -> SomeException -> IO ()
warpHandler Reporter
rpt Maybe Request
_ SomeException
se
    | Just (InvalidRequest
_ :: InvalidRequest) <- SomeException -> Maybe InvalidRequest
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Just (IOException
e :: IOException) <- SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se =
        if IOException -> IOErrorType
ioeGetErrorType IOException
e IOErrorType -> [IOErrorType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [IOErrorType
ResourceVanished, IOErrorType
InvalidArgument]
            then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else Reporter -> Format -> IO ()
report Reporter
rpt (Format -> IO ()) -> Format -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Format
forall a. Show a => a -> Format
bshow SomeException
se
    | Bool
otherwise = Reporter -> Format -> IO ()
report Reporter
rpt (Format -> IO ()) -> Format -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Format
forall a. Show a => a -> Format
bshow SomeException
se

----------------------------------------------------------------

printStdout :: Maybe Request -> SomeException -> IO ()
printStdout :: Maybe Request -> SomeException -> IO ()
printStdout Maybe Request
_ SomeException
x = SomeException -> IO ()
forall a. Show a => a -> IO ()
print SomeException
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout