-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- Monad.Error
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric, BangPatterns #-}
{- | Functions for logging.

    Log msgs are used to report everything from errors and debug msgs to status
    reports.  They are collected in a central place that writes them to a file
    in a machine-readable serialized format.
-}
module Util.Log (
    -- * setup
    configure
    , rotate, rotate_config
    , with_stdio_lock
    -- * msgs
    , Msg(..), msg_string
    -- ** data
    , with_int, with_text, with_dyn
    , lookup_int, lookup_text, lookup_dyn
    -- ** other types
    , Priority(..), State(..)
    , write_json, write_formatted
    , msg, msg_call_stack
    , log
    , timer, debug, notice, warn, error
    , debug_stack, notice_stack, warn_stack, error_stack
    , add_prefix
    -- * LogT monad
    , LogMonad(..)
    , LogT, run, LogId, run_id
    , format_msg
    , serialize, deserialize
) where
import           Prelude hiding (error, log)
import qualified Control.Concurrent.MVar as MVar
import qualified Control.DeepSeq as DeepSeq
import qualified Control.Monad.Error as Error
import qualified Control.Monad.Except as Except
import qualified Control.Monad.Identity as Identity
import qualified Control.Monad.Reader as Reader
import qualified Control.Monad.State as State
import qualified Control.Monad.State.Lazy as State.Lazy
import qualified Control.Monad.State.Strict as State.Strict
import qualified Control.Monad.Trans as Trans
import qualified Control.Monad.Writer.Lazy as Writer

import qualified Data.Aeson as Aeson
import           Data.Aeson (parseJSON, toJSON)
import qualified Data.Aeson.Types as Aeson.Types
import qualified Data.ByteString.Lazy as ByteString.Lazy
import qualified Data.Char as Char
import qualified Data.Dynamic as Dynamic
import qualified Data.Map.Strict as Map
import qualified Data.Monoid as Monoid
import qualified Data.Text as Text
import qualified Data.Text.IO as Text.IO
import qualified Data.Time as Time
import qualified Data.Vector as Vector

import qualified GHC.Generics as Generics
import qualified GHC.Stack
import qualified Numeric
import qualified System.Directory as Directory
import qualified System.Environment as Environment
import qualified System.FilePath as FilePath
import qualified System.IO as IO
import qualified System.IO.Unsafe as Unsafe
import qualified System.Posix as Posix
import qualified System.Process as Process

import qualified Text.ParserCombinators.ReadP as ReadP
import qualified Text.Read as Read

import qualified Util.CallStack as CallStack
import qualified Util.Exceptions as Exceptions
import qualified Util.Logger as Logger
import qualified Util.Serialize as Serialize
import           Util.Serialize (get, get_tag, put, put_tag)

import qualified Derive.Stack as Stack

import           Global


data Msg = Msg {
    Msg -> UTCTime
msg_date :: !Time.UTCTime
    , Msg -> Caller
msg_caller :: !CallStack.Caller
    , Msg -> Priority
msg_priority :: !Priority
    -- | Msgs which are logged from the deriver may record the position in the
    -- score the msg was emitted.
    , Msg -> Maybe Stack
msg_stack :: !(Maybe Stack.Stack)
    -- | Free form text for humans.
    , Msg -> Text
msg_text :: !Text
    , Msg -> Map Text Data
msg_data :: !(Map.Map Text Data)
    } deriving (Msg -> Msg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Msg -> Msg -> Bool
$c/= :: Msg -> Msg -> Bool
== :: Msg -> Msg -> Bool
$c== :: Msg -> Msg -> Bool
Eq, Int -> Msg -> ShowS
[Msg] -> ShowS
Msg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Msg] -> ShowS
$cshowList :: [Msg] -> ShowS
show :: Msg -> String
$cshow :: Msg -> String
showsPrec :: Int -> Msg -> ShowS
$cshowsPrec :: Int -> Msg -> ShowS
Show, ReadPrec [Msg]
ReadPrec Msg
Int -> ReadS Msg
ReadS [Msg]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Msg]
$creadListPrec :: ReadPrec [Msg]
readPrec :: ReadPrec Msg
$creadPrec :: ReadPrec Msg
readList :: ReadS [Msg]
$creadList :: ReadS [Msg]
readsPrec :: Int -> ReadS Msg
$creadsPrec :: Int -> ReadS Msg
Read)

instance DeepSeq.NFData Msg where
    rnf :: Msg -> ()
rnf Msg
msg = forall a. NFData a => a -> ()
DeepSeq.rnf (Msg -> Map Text Data
msg_data Msg
msg) seq :: forall a b. a -> b -> b
`seq` Msg
msg seq :: forall a b. a -> b -> b
`seq` ()

msg_string :: Msg -> String
msg_string :: Msg -> String
msg_string = Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> Text
msg_text

instance Pretty Msg where pretty :: Msg -> Text
pretty = Msg -> Text
format_msg

-- ** data

-- | Attach some semi-structured data to a log msg.  Simple data can then be
-- analyzed without having to parse the text.
data Data = NoData | Int !Int | Text !Text
    -- | Sneak out any domain-specific type, probably for debugging.  Since it
    -- can't be serialized, it will turn into @Text (show dyn)@.
    | Dynamic !Dynamic.Dynamic

instance DeepSeq.NFData Data where
    rnf :: Data -> ()
rnf Data
_ = ()

instance Eq Data where
    Data
a == :: Data -> Data -> Bool
== Data
b = case (Data
a, Data
b) of
        (Data
NoData, Data
NoData) -> Bool
True
        (Int Int
x, Int Int
y) -> Int
x forall a. Eq a => a -> a -> Bool
== Int
y
        (Text Text
x, Text Text
y) -> Text
x forall a. Eq a => a -> a -> Bool
== Text
y
        (Dynamic Dynamic
_, Dynamic Dynamic
_) -> Bool
False
        (Data, Data)
_ -> Bool
False

with_int :: Text -> Int -> Msg -> Msg
with_int :: Text -> Int -> Msg -> Msg
with_int Text
tag = Text -> Data -> Msg -> Msg
with_data Text
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Data
Int

with_text :: Text -> Text -> Msg -> Msg
with_text :: Text -> Text -> Msg -> Msg
with_text Text
tag = Text -> Data -> Msg -> Msg
with_data Text
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Data
Text

with_dyn :: Dynamic.Typeable a => Text -> a -> Msg -> Msg
with_dyn :: forall a. Typeable a => Text -> a -> Msg -> Msg
with_dyn Text
tag = Text -> Data -> Msg -> Msg
with_data Text
tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic -> Data
Dynamic forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> Dynamic
Dynamic.toDyn

with_data :: Text -> Data -> Msg -> Msg
with_data :: Text -> Data -> Msg -> Msg
with_data Text
tag Data
val Msg
msg = Msg
msg { msg_data :: Map Text Data
msg_data = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
tag Data
val (Msg -> Map Text Data
msg_data Msg
msg) }

lookup_int :: Text -> Msg -> Maybe Int
lookup_int :: Text -> Msg -> Maybe Int
lookup_int Text
tag Msg
msg = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
tag (Msg -> Map Text Data
msg_data Msg
msg) of
    Just (Int Int
v) -> forall a. a -> Maybe a
Just Int
v
    Maybe Data
_ -> forall a. Maybe a
Nothing

lookup_text :: Text -> Msg -> Maybe Text
lookup_text :: Text -> Msg -> Maybe Text
lookup_text Text
tag Msg
msg = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
tag (Msg -> Map Text Data
msg_data Msg
msg) of
    Just (Text Text
v) -> forall a. a -> Maybe a
Just Text
v
    Maybe Data
_ -> forall a. Maybe a
Nothing

lookup_dyn :: Dynamic.Typeable a => Text -> Msg -> Maybe a
lookup_dyn :: forall a. Typeable a => Text -> Msg -> Maybe a
lookup_dyn Text
tag Msg
msg = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
tag (Msg -> Map Text Data
msg_data Msg
msg) of
    Just (Dynamic Dynamic
dyn) -> forall a. Typeable a => Dynamic -> Maybe a
Dynamic.fromDynamic Dynamic
dyn
    Maybe Data
_ -> forall a. Maybe a
Nothing

instance Show Data where
    show :: Data -> String
show Data
NoData = String
"NoData"
    -- This omits parens for negative numbers but I don't care much.
    show (Int Int
int) = String
"Int " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
int
    show (Text Text
text) = String
"Text " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
text
    show (Dynamic Dynamic
dyn) =
        String
"Dynamic " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Char
'"') (forall a. Show a => a -> String
show (Dynamic -> SomeTypeRep
Dynamic.dynTypeRep Dynamic
dyn)))

instance Read.Read Data where readPrec :: ReadPrec Data
readPrec = forall a. ReadP a -> ReadPrec a
Read.lift ReadP Data
read_data

read_data :: ReadP.ReadP Data
read_data :: ReadP Data
read_data = forall a. [ReadP a] -> ReadP a
ReadP.choice
    [ String -> ReadP String
ReadP.string String
"NoData" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Data
NoData
    , Int -> Data
Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ReadP String
ReadP.string String
"Int " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP Int
p_int)
    , Text -> Data
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ReadP String
ReadP.string String
"Text " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP String
p_text)
    , Text -> Data
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> ReadP String
ReadP.string String
"Dynamic " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP String
p_text)
    ]
    where
    -- This will break if there is \" in there.  Surely there's a function
    -- to parse a haskell string?
    p_text :: ReadP String
p_text = forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
ReadP.between (String -> ReadP String
ReadP.string String
"\"") (String -> ReadP String
ReadP.string String
"\"")
        ((Char -> Bool) -> ReadP String
ReadP.munch (forall a. Eq a => a -> a -> Bool
/=Char
'"'))
    p_int :: ReadP Int
p_int = forall a. ReadS a -> ReadP a
ReadP.readS_to_P (forall a. Real a => ReadS a -> ReadS a
Numeric.readSigned forall a. (Eq a, Num a) => ReadS a
Numeric.readDec)

-- ** other types

-- | Pure code can't give a date, but making msg_date Maybe makes it awkward
-- for everyone who processes Msgs, so cheat with this.
no_date_yet :: Time.UTCTime
no_date_yet :: UTCTime
no_date_yet = Day -> DiffTime -> UTCTime
Time.UTCTime (Integer -> Day
Time.ModifiedJulianDay Integer
0) DiffTime
0

-- | Logging state.  Don't log if a handle is Nothing.
data State = State {
    State -> Msg -> IO ()
state_write_msg :: Msg -> IO ()
    , State -> Priority
state_priority :: Priority
    }

-- | Write logs as JSON to the given handle.
write_json :: IO.Handle -> Msg -> IO ()
write_json :: Handle -> Msg -> IO ()
write_json Handle
hdl Msg
log_msg = do
    Handle -> ByteString -> IO ()
ByteString.Lazy.hPut Handle
hdl (Msg -> ByteString
serialize Msg
log_msg)
    Handle -> ByteString -> IO ()
ByteString.Lazy.hPut Handle
hdl ByteString
"\n"

-- | Write logs as human-readable text.
write_formatted :: IO.Handle -> Msg -> IO ()
write_formatted :: Handle -> Msg -> IO ()
write_formatted Handle
hdl = Handle -> Text -> IO ()
Text.IO.hPutStrLn Handle
hdl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg -> Text
format_msg

initial_state :: State
initial_state :: State
initial_state = State
    { state_write_msg :: Msg -> IO ()
state_write_msg = Handle -> Msg -> IO ()
write_formatted Handle
IO.stderr
    , state_priority :: Priority
state_priority = Priority
Notice
    }

{-# NOINLINE global_state #-}
global_state :: MVar.MVar State
global_state :: MVar State
global_state = forall a. IO a -> a
Unsafe.unsafePerformIO (forall a. a -> IO (MVar a)
MVar.newMVar State
initial_state)

-- * setup

rotate :: FilePath -> IO IO.Handle
rotate :: String -> IO Handle
rotate = Int -> Int -> String -> IO Handle
rotate_config Int
4 (Int
4 forall a. Num a => a -> a -> a
* Int
mb)
    where mb :: Int
mb = Int
1024forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2

-- | Get a file handle for writing log msgs, first rotating logs if necessary.
rotate_config :: Int -> Int -> FilePath -> IO IO.Handle
rotate_config :: Int -> Int -> String -> IO Handle
rotate_config Int
keep Int
max_size String
log_fn = do
    let rotated_fn :: a -> String
rotated_fn a
n = String
log_fn forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n forall a. [a] -> [a] -> [a]
++ String
".gz"
    FileOffset
size <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe FileOffset
0 FileStatus -> FileOffset
Posix.fileSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}. IO a -> IO (Maybe a)
ignore (String -> IO FileStatus
Posix.getFileStatus String
log_fn)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FileOffset
size forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
max_size) forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> [a]
reverse (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
keep] (forall a. Int -> [a] -> [a]
drop Int
1 [Int
1..Int
keep]))) forall a b. (a -> b) -> a -> b
$ \(Int
from, Int
to) ->
            forall {a}. IO a -> IO (Maybe a)
ignore forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
Directory.renameFile (forall a. Show a => a -> String
rotated_fn Int
from) (forall a. Show a => a -> String
rotated_fn Int
to)
        let fn :: String
fn = ShowS
FilePath.dropExtension (forall a. Show a => a -> String
rotated_fn Integer
1)
        Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr forall a b. (a -> b) -> a -> b
$ String
"rotate logs " forall a. [a] -> [a] -> [a]
++ String
log_fn forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ String
fn
        forall {a}. IO a -> IO (Maybe a)
ignore forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
Directory.renameFile String
log_fn String
fn
        ProcessHandle -> IO ExitCode
Process.waitForProcess forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
Process.runProcess String
"gzip" [String
fn]
            forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Handle
hdl <- String -> IOMode -> IO Handle
IO.openFile String
log_fn IOMode
IO.AppendMode
    -- Logs are per-line, so ensure they go out promptly.
    Handle -> BufferMode -> IO ()
IO.hSetBuffering Handle
hdl BufferMode
IO.LineBuffering
    forall (m :: * -> *) a. Monad m => a -> m a
return Handle
hdl
    where ignore :: IO a -> IO (Maybe a)
ignore = forall {a}. IO a -> IO (Maybe a)
Exceptions.ignoreEnoent

-- | Configure the logging system by modifying its internal state.
configure :: (State -> State) -> IO ()
configure :: (State -> State) -> IO ()
configure State -> State
f = forall a. MVar a -> (a -> IO a) -> IO ()
MVar.modifyMVar_ MVar State
global_state (State -> IO State
with_log_config forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> State
f)

with_log_config :: State -> IO State
with_log_config :: State -> IO State
with_log_config State
state = do
    String
config_str <- forall a. a -> Maybe a -> a
fromMaybe String
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
Environment.lookupEnv String
"LOG_CONFIG"
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. (Stack, MonadIO m) => Text -> m a
errorIO forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> State -> Either Text State
parse_log_config String
config_str State
state

parse_log_config :: String -> State -> Either Text State
parse_log_config :: String -> State -> Either Text State
parse_log_config String
str State
state
    | String
str forall a. Eq a => a -> a -> Bool
== String
"" = forall a b. b -> Either a b
Right State
state
    | Just Priority
prio <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ShowS
lower String
str) Map String Priority
priorities =
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ State
state { state_priority :: Priority
state_priority = Priority
prio }
    | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text
"can't parse LOG_CONFIG: " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show String
str)
    where
    priorities :: Map String Priority
priorities = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map (ShowS
lower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [Priority]
ps) [Priority]
ps
        where ps :: [Priority]
ps = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound] :: [Priority]
    lower :: ShowS
lower = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower

-- | Reuse the log lock, presumably to write to stdout or stderr.  It doesn't
-- really belong here, but stdout and stderr are already global, so reusing
-- a lock for them doesn't seem like a big deal.
with_stdio_lock :: IO () -> IO ()
with_stdio_lock :: IO () -> IO ()
with_stdio_lock IO ()
action = do
    forall a b. MVar a -> (a -> IO b) -> IO b
MVar.withMVar MVar State
global_state forall a b. (a -> b) -> a -> b
$ \State
state -> IO ()
action forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return State
state
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Priority =
    -- | Logs to determine where things are hanging when debugging
    -- a performance problem.  Use "LogView.ShowTimers" to show the time
    -- elapsed between Timer logs.
    Timer
    -- | Users don't look at this during normal use, but can be useful for
    -- debugging.
    | Debug
    -- | Informational msgs that the user might want to see.  Progress messages
    -- in e.g. derivation and play status are included here.
    | Notice
    -- | Something went wrong in e.g. derivation.  The user definitely wants to
    -- see this.
    | Warn
    -- | Unexpected error in the app, which may quit.  This is probably due to
    -- a bug.
    | Error
    deriving (Priority
forall a. a -> a -> Bounded a
maxBound :: Priority
$cmaxBound :: Priority
minBound :: Priority
$cminBound :: Priority
Bounded, Int -> Priority
Priority -> Int
Priority -> [Priority]
Priority -> Priority
Priority -> Priority -> [Priority]
Priority -> Priority -> Priority -> [Priority]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Priority -> Priority -> Priority -> [Priority]
$cenumFromThenTo :: Priority -> Priority -> Priority -> [Priority]
enumFromTo :: Priority -> Priority -> [Priority]
$cenumFromTo :: Priority -> Priority -> [Priority]
enumFromThen :: Priority -> Priority -> [Priority]
$cenumFromThen :: Priority -> Priority -> [Priority]
enumFrom :: Priority -> [Priority]
$cenumFrom :: Priority -> [Priority]
fromEnum :: Priority -> Int
$cfromEnum :: Priority -> Int
toEnum :: Int -> Priority
$ctoEnum :: Int -> Priority
pred :: Priority -> Priority
$cpred :: Priority -> Priority
succ :: Priority -> Priority
$csucc :: Priority -> Priority
Enum, Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Priority] -> ShowS
$cshowList :: [Priority] -> ShowS
show :: Priority -> String
$cshow :: Priority -> String
showsPrec :: Int -> Priority -> ShowS
$cshowsPrec :: Int -> Priority -> ShowS
Show, ReadPrec [Priority]
ReadPrec Priority
Int -> ReadS Priority
ReadS [Priority]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Priority]
$creadListPrec :: ReadPrec [Priority]
readPrec :: ReadPrec Priority
$creadPrec :: ReadPrec Priority
readList :: ReadS [Priority]
$creadList :: ReadS [Priority]
readsPrec :: Int -> ReadS Priority
$creadsPrec :: Int -> ReadS Priority
Read, Priority -> Priority -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c== :: Priority -> Priority -> Bool
Eq, Eq Priority
Priority -> Priority -> Bool
Priority -> Priority -> Ordering
Priority -> Priority -> Priority
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Priority -> Priority -> Priority
$cmin :: Priority -> Priority -> Priority
max :: Priority -> Priority -> Priority
$cmax :: Priority -> Priority -> Priority
>= :: Priority -> Priority -> Bool
$c>= :: Priority -> Priority -> Bool
> :: Priority -> Priority -> Bool
$c> :: Priority -> Priority -> Bool
<= :: Priority -> Priority -> Bool
$c<= :: Priority -> Priority -> Bool
< :: Priority -> Priority -> Bool
$c< :: Priority -> Priority -> Bool
compare :: Priority -> Priority -> Ordering
$ccompare :: Priority -> Priority -> Ordering
Ord, forall x. Rep Priority x -> Priority
forall x. Priority -> Rep Priority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Priority x -> Priority
$cfrom :: forall x. Priority -> Rep Priority x
Generics.Generic)

-- | Create a msg without initializing it, so it doesn't have to be in
-- LogMonad.
msg :: CallStack.Stack => Priority -> Maybe Stack.Stack -> Text -> Msg
msg :: Stack => Priority -> Maybe Stack -> Text -> Msg
msg = CallStack -> Priority -> Maybe Stack -> Text -> Msg
msg_call_stack Stack => CallStack
GHC.Stack.callStack

-- | Like 'msg' but when you already have a CallStack.
msg_call_stack :: GHC.Stack.CallStack -> Priority -> Maybe Stack.Stack -> Text
    -> Msg
msg_call_stack :: CallStack -> Priority -> Maybe Stack -> Text -> Msg
msg_call_stack CallStack
call_stack Priority
prio Maybe Stack
stack Text
text =
    UTCTime
-> Caller
-> Priority
-> Maybe Stack
-> Text
-> Map Text Data
-> Msg
Msg UTCTime
no_date_yet (CallStack -> Caller
CallStack.caller CallStack
call_stack) Priority
prio Maybe Stack
stack Text
text forall a. Monoid a => a
mempty

log :: (CallStack.Stack, LogMonad m) => Priority -> Text -> m ()
log :: forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Text -> m ()
log Priority
prio Text
text = forall (m :: * -> *). LogMonad m => Msg -> m ()
write forall a b. (a -> b) -> a -> b
$ Stack => Priority -> Maybe Stack -> Text -> Msg
msg Priority
prio forall a. Maybe a
Nothing Text
text

log_stack :: (CallStack.Stack, LogMonad m) => Priority -> Stack.Stack -> Text
    -> m ()
log_stack :: forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Stack -> Text -> m ()
log_stack Priority
prio Stack
stack Text
text = forall (m :: * -> *). LogMonad m => Msg -> m ()
write forall a b. (a -> b) -> a -> b
$ Stack => Priority -> Maybe Stack -> Text -> Msg
msg Priority
prio (forall a. a -> Maybe a
Just Stack
stack) Text
text

timer, debug, notice, warn, error
    :: (CallStack.Stack, LogMonad m) => Text -> m ()
timer :: forall (m :: * -> *). (Stack, LogMonad m) => Text -> m ()
timer = forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Text -> m ()
log Priority
Timer
debug :: forall (m :: * -> *). (Stack, LogMonad m) => Text -> m ()
debug = forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Text -> m ()
log Priority
Debug
notice :: forall (m :: * -> *). (Stack, LogMonad m) => Text -> m ()
notice = forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Text -> m ()
log Priority
Notice
warn :: forall (m :: * -> *). (Stack, LogMonad m) => Text -> m ()
warn = forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Text -> m ()
log Priority
Warn
error :: forall (m :: * -> *). (Stack, LogMonad m) => Text -> m ()
error = forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Text -> m ()
log Priority
Error

-- Yay permutation game.  I could probably do a typeclass trick to make 'stack'
-- an optional arg, but I think I'd wind up with all the same boilerplate here.
debug_stack, notice_stack, warn_stack, error_stack
    :: (CallStack.Stack, LogMonad m) => Stack.Stack -> Text -> m ()
debug_stack :: forall (m :: * -> *). (Stack, LogMonad m) => Stack -> Text -> m ()
debug_stack = forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Stack -> Text -> m ()
log_stack Priority
Debug
notice_stack :: forall (m :: * -> *). (Stack, LogMonad m) => Stack -> Text -> m ()
notice_stack = forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Stack -> Text -> m ()
log_stack Priority
Notice
warn_stack :: forall (m :: * -> *). (Stack, LogMonad m) => Stack -> Text -> m ()
warn_stack = forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Stack -> Text -> m ()
log_stack Priority
Warn
error_stack :: forall (m :: * -> *). (Stack, LogMonad m) => Stack -> Text -> m ()
error_stack = forall (m :: * -> *).
(Stack, LogMonad m) =>
Priority -> Stack -> Text -> m ()
log_stack Priority
Error

-- | Prefix a msg with the given string.
add_prefix :: Text -> Msg -> Msg
add_prefix :: Text -> Msg -> Msg
add_prefix Text
pref Msg
m = Msg
m { msg_text :: Text
msg_text = Text
pref forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Msg -> Text
msg_text Msg
m }

-- * LogT

-- | Previously there was an initialize_msg method, which could use the
-- LogMonad to fill in fields, e.g. 'add_time'.  Those things can happen in
-- 'write' too, but the msg could be created in a different context from the
-- call to 'write'.  In practice, though, I don't do that very much, and when
-- I did it was usually because I wasn't in a LogMonad at all, so I used the
-- pure 'msg' function.
class Monad m => LogMonad m where
    write :: Msg -> m ()

instance LogMonad IO where
    write :: Msg -> IO ()
write Msg
log_msg = forall a b. MVar a -> (a -> IO b) -> IO b
MVar.withMVar MVar State
global_state forall a b. (a -> b) -> a -> b
$ \(State Msg -> IO ()
write_msg Priority
prio) ->
        -- global_state also acts as a lock.
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Priority
prio forall a. Ord a => a -> a -> Bool
<= Msg -> Priority
msg_priority Msg
log_msg) forall a b. (a -> b) -> a -> b
$ do
            Msg
log_msg <- Msg -> IO Msg
add_time Msg
log_msg
            Msg -> IO ()
write_msg Msg
log_msg

-- | Format a msg in a nice user readable way.
format_msg :: Msg -> Text
format_msg :: Msg -> Text
format_msg (Msg UTCTime
_date Caller
caller Priority
prio Maybe Stack
stack Text
text Map Text Data
_data) =
    Text
log_msg forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
" "<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Text
pretty) Maybe Stack
stack
    where
    prio_symbol :: Priority -> Text
prio_symbol Priority
Timer = Text
"/"
    prio_symbol Priority
prio = Int -> Text -> Text
Text.replicate (forall a. Enum a => a -> Int
fromEnum Priority
prio) Text
"-"
    log_msg :: Text
log_msg = forall a. Monoid a => [a] -> a
mconcat
        [ Int -> Char -> Text -> Text
Text.justifyLeft Int
5 Char
' ' (Priority -> Text
prio_symbol Priority
prio)
        , Caller -> Text
CallStack.showCaller Caller
caller
        , Text
" - "
        , Text
text
        ]

-- | Add a time to the msg if it doesn't already have one.
add_time :: Msg -> IO Msg
add_time :: Msg -> IO Msg
add_time Msg
log_msg
    | Msg -> UTCTime
msg_date Msg
log_msg forall a. Eq a => a -> a -> Bool
== UTCTime
no_date_yet = do
        UTCTime
utc <- IO UTCTime
Time.getCurrentTime
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Msg
log_msg { msg_date :: UTCTime
msg_date = UTCTime
utc }
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Msg
log_msg

instance Monad m => LogMonad (LogT m) where
    write :: Msg -> LogT m ()
write = forall (m :: * -> *). Monad m => Msg -> LogT m ()
write_msg

write_msg :: Monad m => Msg -> LogT m ()
write_msg :: forall (m :: * -> *). Monad m => Msg -> LogT m ()
write_msg = forall (m :: * -> *) a. LogM m a -> LogT m a
LogT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadLogger w m => w -> m ()
Logger.log

type LogM m = Logger.LoggerT Msg m
newtype LogT m a = LogT { forall (m :: * -> *) a. LogT m a -> LogM m a
run_log_t :: LogM m a }
    deriving (forall a. a -> LogT m a
forall a b. LogT m a -> LogT m b -> LogT m a
forall a b. LogT m a -> LogT m b -> LogT m b
forall a b. LogT m (a -> b) -> LogT m a -> LogT m b
forall a b c. (a -> b -> c) -> LogT m a -> LogT m b -> LogT m c
forall {m :: * -> *}. Monad m => Functor (LogT m)
forall (m :: * -> *) a. Monad m => a -> LogT m a
forall (m :: * -> *) a b.
Monad m =>
LogT m a -> LogT m b -> LogT m a
forall (m :: * -> *) a b.
Monad m =>
LogT m a -> LogT m b -> LogT m b
forall (m :: * -> *) a b.
Monad m =>
LogT m (a -> b) -> LogT m a -> LogT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> LogT m a -> LogT m b -> LogT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. LogT m a -> LogT m b -> LogT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
LogT m a -> LogT m b -> LogT m a
*> :: forall a b. LogT m a -> LogT m b -> LogT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
LogT m a -> LogT m b -> LogT m b
liftA2 :: forall a b c. (a -> b -> c) -> LogT m a -> LogT m b -> LogT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> LogT m a -> LogT m b -> LogT m c
<*> :: forall a b. LogT m (a -> b) -> LogT m a -> LogT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
LogT m (a -> b) -> LogT m a -> LogT m b
pure :: forall a. a -> LogT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> LogT m a
Applicative, forall a b. a -> LogT m b -> LogT m a
forall a b. (a -> b) -> LogT m a -> LogT m b
forall (m :: * -> *) a b. Functor m => a -> LogT m b -> LogT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LogT m a -> LogT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LogT m b -> LogT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> LogT m b -> LogT m a
fmap :: forall a b. (a -> b) -> LogT m a -> LogT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> LogT m a -> LogT m b
Functor, forall a. a -> LogT m a
forall a b. LogT m a -> LogT m b -> LogT m b
forall a b. LogT m a -> (a -> LogT m b) -> LogT m b
forall (m :: * -> *). Monad m => Applicative (LogT m)
forall (m :: * -> *) a. Monad m => a -> LogT m a
forall (m :: * -> *) a b.
Monad m =>
LogT m a -> LogT m b -> LogT m b
forall (m :: * -> *) a b.
Monad m =>
LogT m a -> (a -> LogT m b) -> LogT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> LogT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> LogT m a
>> :: forall a b. LogT m a -> LogT m b -> LogT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
LogT m a -> LogT m b -> LogT m b
>>= :: forall a b. LogT m a -> (a -> LogT m b) -> LogT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
LogT m a -> (a -> LogT m b) -> LogT m b
Monad, forall a. IO a -> LogT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (LogT m)
forall (m :: * -> *) a. MonadIO m => IO a -> LogT m a
liftIO :: forall a. IO a -> LogT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> LogT m a
Trans.MonadIO,
        forall (m :: * -> *) a. Monad m => m a -> LogT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> LogT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> LogT m a
Trans.MonadTrans, Except.MonadError e, State.MonadState st,
        Reader.MonadReader r)

run :: Monad m => LogT m a -> m (a, [Msg])
run :: forall (m :: * -> *) a. Monad m => LogT m a -> m (a, [Msg])
run = forall (m :: * -> *) w a. Monad m => LoggerT w m a -> m (a, [w])
Logger.run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. LogT m a -> LogM m a
run_log_t

type LogId a = LogT Identity.Identity a

run_id :: LogId a -> (a, [Msg])
run_id :: forall a. LogId a -> (a, [Msg])
run_id = forall a. Identity a -> a
Identity.runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => LogT m a -> m (a, [Msg])
run

-- ** mtl instances

instance LogMonad m => LogMonad (State.Strict.StateT s m) where
    write :: Msg -> StateT s m ()
write = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). LogMonad m => Msg -> m ()
write
instance LogMonad m => LogMonad (State.Lazy.StateT s m) where
    write :: Msg -> StateT s m ()
write = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). LogMonad m => Msg -> m ()
write
instance (Error.Error e, LogMonad m) => LogMonad (Error.ErrorT e m) where
    write :: Msg -> ErrorT e m ()
write = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). LogMonad m => Msg -> m ()
write
instance LogMonad m => LogMonad (Except.ExceptT e m) where
    write :: Msg -> ExceptT e m ()
write = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). LogMonad m => Msg -> m ()
write
instance LogMonad m => LogMonad (Reader.ReaderT r m) where
    write :: Msg -> ReaderT r m ()
write = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). LogMonad m => Msg -> m ()
write
instance (Monoid.Monoid w, LogMonad m) => LogMonad (Writer.WriterT w m) where
    write :: Msg -> WriterT w m ()
write = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). LogMonad m => Msg -> m ()
write

-- * serialize

-- | Serialize a log msg.  Newline separated text is nice because it's human
-- readable and can use newlines for records.  Previously I used Show, which is
-- bulky and slow.  JSON is hopefully faster, and retains the benefits of Show.
serialize :: Msg -> ByteString.Lazy.ByteString
serialize :: Msg -> ByteString
serialize (Msg UTCTime
date Caller
caller Priority
prio Maybe Stack
stack Text
text Map Text Data
data_) =
    forall a. ToJSON a => a -> ByteString
Aeson.encode forall a b. (a -> b) -> a -> b
$ Array -> Value
Aeson.Array forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Vector a
Vector.fromList
        [ forall a. ToJSON a => a -> Value
toJSON UTCTime
date, forall a. ToJSON a => a -> Value
toJSON Caller
caller, forall a. ToJSON a => a -> Value
toJSON Priority
prio, forall a. ToJSON a => a -> Value
toJSON Maybe Stack
stack, forall a. ToJSON a => a -> Value
toJSON Text
text
        , forall a. ToJSON a => a -> Value
toJSON Map Text Data
data_
        ]

deserialize :: ByteString.Lazy.ByteString -> Either String Msg
deserialize :: ByteString -> Either String Msg
deserialize ByteString
bytes = case forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode ByteString
bytes of
    Just (Aeson.Array Array
a) -> case forall a. Vector a -> [a]
Vector.toList Array
a of
        [Value
date, Value
caller, Value
prio, Value
stack, Value
text, Value
data_] ->
            forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Parser b) -> a -> Either String b
Aeson.Types.parseEither () forall a b. (a -> b) -> a -> b
$ \() ->
                UTCTime
-> Caller
-> Priority
-> Maybe Stack
-> Text
-> Map Text Data
-> Msg
Msg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
date forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON Value
caller
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON Value
prio forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON Value
stack forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON Value
text
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromJSON a => Value -> Parser a
parseJSON Value
data_
        [Value]
_ -> forall a b. a -> Either a b
Left String
"expected a 6 element array"
    Maybe Value
_ -> forall a b. a -> Either a b
Left String
"can't decode json"

instance Aeson.ToJSON Priority
instance Aeson.FromJSON Priority

instance Aeson.ToJSON Data where
    toJSON :: Data -> Value
toJSON Data
d = case Data
d of
        Data
NoData -> Value
Aeson.Null
        Int Int
v -> Scientific -> Value
Aeson.Number (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v)
        Text Text
v -> Text -> Value
Aeson.String Text
v
        Dynamic Dynamic
v -> Text -> Value
Aeson.String (String -> Text
Text.pack (forall a. Show a => a -> String
show Dynamic
v))

instance Aeson.FromJSON Data where
    parseJSON :: Value -> Parser Data
parseJSON Value
json = case Value
json of
        Value
Aeson.Null -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Data
NoData
        Aeson.Number Scientific
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Data
Int (forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
v)
        Aeson.String Text
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Data
Text Text
v
        Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expecting null, number, or string"

-- TODO: this is only used by ReplProtocol, maybe it could use JSON?
-- Or just send preformatted log msgs.
instance Serialize.Serialize Msg where
    put :: Putter Msg
put (Msg UTCTime
a Caller
b Priority
c Maybe Stack
d Text
e Map Text Data
f) = forall a. Serialize a => Putter a
put UTCTime
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Caller
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Priority
c forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Maybe Stack
d forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Text
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Map Text Data
f
    get :: Get Msg
get = UTCTime
-> Caller
-> Priority
-> Maybe Stack
-> Text
-> Map Text Data
-> Msg
Msg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Serialize a => Get a
get

instance Serialize.Serialize Priority where
    put :: Putter Priority
put = forall a. Enum a => a -> PutM ()
Serialize.put_enum_unsafe
    get :: Get Priority
get = forall a. (Bounded a, Enum a) => Get a
Serialize.get_enum_unsafe

instance Serialize.Serialize Data where
    put :: Putter Data
put Data
NoData = Word8 -> PutM ()
put_tag Word8
0
    put (Int Int
a) = Word8 -> PutM ()
put_tag Word8
1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Int
a
    put (Text Text
a) = Word8 -> PutM ()
put_tag Word8
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Serialize a => Putter a
put Text
a
    put (Dynamic Dynamic
a) = forall a. Serialize a => Putter a
put (Text -> Data
Text (forall a. Show a => a -> Text
showt Dynamic
a))
    get :: Get Data
get = Get Word8
get_tag forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
tag -> case Word8
tag of
        Word8
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Data
NoData
        Word8
1 -> Int -> Data
Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get
        Word8
2 -> Text -> Data
Text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Serialize a => Get a
get
        Word8
_ -> forall a. String -> Word8 -> Get a
Serialize.bad_tag String
"Data" Word8
tag