{-# LANGUAGE RecordWildCards, ViewPatterns, TupleSections, PatternGuards #-}
module General.Log(
Log, logCreate, logNone, logAddMessage, logAddEntry,
Summary(..), logSummary,
) where
import Control.Concurrent.Extra
import Control.Applicative
import System.Directory
import System.IO
import Data.Hashable
import Data.Time.Calendar
import Data.Time.Clock
import Numeric.Extra
import Control.Monad.Extra
import qualified Data.IntSet as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Char8 as BS
import Data.Semigroup
import General.Util
import Data.Maybe
import Data.List
import Data.IORef.Extra
import Prelude
data Log = Log
{Log -> Maybe (Var Handle)
logOutput :: Maybe (Var Handle)
,Log -> IORef (Map Day SummaryI)
logCurrent :: IORef (Map.Map Day SummaryI)
,Log -> String -> Bool
logInteresting :: String -> Bool
}
showTime :: UTCTime -> String
showTime :: UTCTime -> String
showTime = String -> UTCTime -> String
showUTCTime String
"%Y-%m-%dT%H:%M:%S%Q"
logNone :: IO Log
logNone :: IO Log
logNone = do IORef (Map Day SummaryI)
ref <- Map Day SummaryI -> IO (IORef (Map Day SummaryI))
forall a. a -> IO (IORef a)
newIORef Map Day SummaryI
forall k a. Map k a
Map.empty; Log -> IO Log
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Log -> IO Log) -> Log -> IO Log
forall a b. (a -> b) -> a -> b
$ Maybe (Var Handle)
-> IORef (Map Day SummaryI) -> (String -> Bool) -> Log
Log Maybe (Var Handle)
forall a. Maybe a
Nothing IORef (Map Day SummaryI)
ref (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
False)
logCreate :: Either Handle FilePath -> (BS.ByteString -> Bool) -> IO Log
logCreate :: Either Handle String -> (ByteString -> Bool) -> IO Log
logCreate Either Handle String
store ByteString -> Bool
interesting = do
(Handle
h, Map Day SummaryI
old) <- case Either Handle String
store of
Left Handle
h -> (Handle, Map Day SummaryI) -> IO (Handle, Map Day SummaryI)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handle
h, Map Day SummaryI
forall k a. Map k a
Map.empty)
Right String
file -> do
Bool
b <- String -> IO Bool
doesFileExist String
file
Map Day SummaryI
mp <- if Bool -> Bool
not Bool
b then Map Day SummaryI -> IO (Map Day SummaryI)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Day SummaryI
forall k a. Map k a
Map.empty else String
-> IOMode
-> (Handle -> IO (Map Day SummaryI))
-> IO (Map Day SummaryI)
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
file IOMode
ReadMode ((Handle -> IO (Map Day SummaryI)) -> IO (Map Day SummaryI))
-> (Handle -> IO (Map Day SummaryI)) -> IO (Map Day SummaryI)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
ByteString
src <- Handle -> IO ByteString
LBS.hGetContents Handle
h
let xs :: [(Day, SummaryI)]
xs = (ByteString -> Maybe (Day, SummaryI))
-> [ByteString] -> [(Day, SummaryI)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((ByteString -> Bool) -> ByteString -> Maybe (Day, SummaryI)
parseLogLine ByteString -> Bool
interesting (ByteString -> Maybe (Day, SummaryI))
-> (ByteString -> ByteString)
-> ByteString
-> Maybe (Day, SummaryI)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict) ([ByteString] -> [(Day, SummaryI)])
-> [ByteString] -> [(Day, SummaryI)]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
LBS.lines ByteString
src
Map Day SummaryI -> IO (Map Day SummaryI)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Day SummaryI -> IO (Map Day SummaryI))
-> Map Day SummaryI -> IO (Map Day SummaryI)
forall a b. (a -> b) -> a -> b
$! (Map Day SummaryI -> (Day, SummaryI) -> Map Day SummaryI)
-> Map Day SummaryI -> [(Day, SummaryI)] -> Map Day SummaryI
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map Day SummaryI
mp (Day
k,SummaryI
v) -> (Maybe SummaryI -> Maybe SummaryI)
-> Day -> Map Day SummaryI -> Map Day SummaryI
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (SummaryI -> Maybe SummaryI
forall a. a -> Maybe a
Just (SummaryI -> Maybe SummaryI)
-> (Maybe SummaryI -> SummaryI) -> Maybe SummaryI -> Maybe SummaryI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SummaryI -> (SummaryI -> SummaryI) -> Maybe SummaryI -> SummaryI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SummaryI
v (SummaryI -> SummaryI -> SummaryI
forall a. Semigroup a => a -> a -> a
<> SummaryI
v)) Day
k Map Day SummaryI
mp) Map Day SummaryI
forall k a. Map k a
Map.empty [(Day, SummaryI)]
xs
(,Map Day SummaryI
mp) (Handle -> (Handle, Map Day SummaryI))
-> IO Handle -> IO (Handle, Map Day SummaryI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IOMode -> IO Handle
openFile String
file IOMode
AppendMode
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
Var Handle
var <- Handle -> IO (Var Handle)
forall a. a -> IO (Var a)
newVar Handle
h
IORef (Map Day SummaryI)
ref <- Map Day SummaryI -> IO (IORef (Map Day SummaryI))
forall a. a -> IO (IORef a)
newIORef Map Day SummaryI
old
Log -> IO Log
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Log -> IO Log) -> Log -> IO Log
forall a b. (a -> b) -> a -> b
$ Maybe (Var Handle)
-> IORef (Map Day SummaryI) -> (String -> Bool) -> Log
Log (Var Handle -> Maybe (Var Handle)
forall a. a -> Maybe a
Just Var Handle
var) IORef (Map Day SummaryI)
ref (ByteString -> Bool
interesting (ByteString -> Bool) -> (String -> ByteString) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack)
logAddMessage :: Log -> String -> IO ()
logAddMessage :: Log -> String -> IO ()
logAddMessage Log{Maybe (Var Handle)
IORef (Map Day SummaryI)
String -> Bool
logInteresting :: String -> Bool
logCurrent :: IORef (Map Day SummaryI)
logOutput :: Maybe (Var Handle)
logInteresting :: Log -> String -> Bool
logCurrent :: Log -> IORef (Map Day SummaryI)
logOutput :: Log -> Maybe (Var Handle)
..} String
msg = do
String
time <- UTCTime -> String
showTime (UTCTime -> String) -> IO UTCTime -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
Maybe (Var Handle) -> (Var Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Var Handle)
logOutput ((Var Handle -> IO ()) -> IO ()) -> (Var Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Var Handle
var -> Var Handle -> (Handle -> IO ()) -> IO ()
forall a b. Var a -> (a -> IO b) -> IO b
withVar Var Handle
var ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
time String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
logAddEntry :: Log -> String -> String -> Double -> Maybe String -> IO ()
logAddEntry :: Log -> String -> String -> Double -> Maybe String -> IO ()
logAddEntry Log{Maybe (Var Handle)
IORef (Map Day SummaryI)
String -> Bool
logInteresting :: String -> Bool
logCurrent :: IORef (Map Day SummaryI)
logOutput :: Maybe (Var Handle)
logInteresting :: Log -> String -> Bool
logCurrent :: Log -> IORef (Map Day SummaryI)
logOutput :: Log -> Maybe (Var Handle)
..} String
user String
question Double
taken Maybe String
err = do
UTCTime
time <- IO UTCTime
getCurrentTime
let add :: SummaryI -> IO ()
add SummaryI
v = IORef (Map Day SummaryI)
-> (Map Day SummaryI -> Map Day SummaryI) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef (Map Day SummaryI)
logCurrent ((Map Day SummaryI -> Map Day SummaryI) -> IO ())
-> (Map Day SummaryI -> Map Day SummaryI) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Map Day SummaryI
mp -> (Maybe SummaryI -> Maybe SummaryI)
-> Day -> Map Day SummaryI -> Map Day SummaryI
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (SummaryI -> Maybe SummaryI
forall a. a -> Maybe a
Just (SummaryI -> Maybe SummaryI)
-> (Maybe SummaryI -> SummaryI) -> Maybe SummaryI -> Maybe SummaryI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SummaryI -> (SummaryI -> SummaryI) -> Maybe SummaryI -> SummaryI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SummaryI
v (SummaryI -> SummaryI -> SummaryI
forall a. Semigroup a => a -> a -> a
<> SummaryI
v)) (UTCTime -> Day
utctDay UTCTime
time) Map Day SummaryI
mp
if String -> Bool
logInteresting String
question then
SummaryI -> IO ()
add (SummaryI -> IO ()) -> SummaryI -> IO ()
forall a b. (a -> b) -> a -> b
$ IntSet -> Int -> Double -> Average Double -> Int -> SummaryI
SummaryI (Int -> IntSet
Set.singleton (Int -> IntSet) -> Int -> IntSet
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
forall a. Hashable a => a -> Int
hash (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ String -> ByteString
LBS.pack String
user) Int
1 Double
taken (Double -> Average Double
forall a. a -> Average a
toAverage Double
taken) (if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
err then Int
1 else Int
0)
else if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
err then
SummaryI -> IO ()
add SummaryI
forall a. Monoid a => a
mempty{iErrors :: Int
iErrors=Int
1}
else
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Maybe (Var Handle) -> (Var Handle -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (Var Handle)
logOutput ((Var Handle -> IO ()) -> IO ()) -> (Var Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Var Handle
var -> Var Handle -> (Handle -> IO ()) -> IO ()
forall a b. Var a -> (a -> IO b) -> IO b
withVar Var Handle
var ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h ->
Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [UTCTime -> String
showTime UTCTime
time, String
user, Int -> Double -> String
forall a. RealFloat a => Int -> a -> String
showDP Int
3 Double
taken, String
question] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList ((String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) String
"ERROR: " (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) Maybe String
err)
data Summary = Summary
{Summary -> Day
summaryDate :: Day
,Summary -> Int
summaryUsers :: {-# UNPACK #-} !Int
,Summary -> Int
summaryUses :: {-# UNPACK #-} !Int
,Summary -> Double
summarySlowest :: {-# UNPACK #-} !Double
,Summary -> Average Double
summaryAverage :: {-# UNPACK #-} !(Average Double)
,Summary -> Int
summaryErrors :: {-# UNPACK #-} !Int
}
data SummaryI = SummaryI
{SummaryI -> IntSet
iUsers :: !Set.IntSet
,SummaryI -> Int
iUses :: !Int
,SummaryI -> Double
iSlowest :: !Double
,SummaryI -> Average Double
iAverage :: !(Average Double)
,SummaryI -> Int
iErrors :: !Int
}
instance Semigroup SummaryI where
SummaryI IntSet
x1 Int
x2 Double
x3 Average Double
x4 Int
x5 <> :: SummaryI -> SummaryI -> SummaryI
<> SummaryI IntSet
y1 Int
y2 Double
y3 Average Double
y4 Int
y5 =
IntSet -> Int -> Double -> Average Double -> Int -> SummaryI
SummaryI (IntSet -> IntSet -> IntSet
f IntSet
x1 IntSet
y1) (Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y2) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
x3 Double
y3) (Average Double
x4 Average Double -> Average Double -> Average Double
forall a. Semigroup a => a -> a -> a
<> Average Double
y4) (Int
x5Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y5)
where f :: IntSet -> IntSet -> IntSet
f IntSet
x IntSet
y | IntSet -> Int
Set.size IntSet
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> IntSet -> IntSet
Set.insert ([Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
Set.toList IntSet
x) IntSet
y
| IntSet -> Int
Set.size IntSet
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> IntSet -> IntSet
Set.insert ([Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ IntSet -> [Int]
Set.toList IntSet
y) IntSet
x
| Bool
otherwise = IntSet -> IntSet -> IntSet
Set.union IntSet
x IntSet
y
instance Monoid SummaryI where
mempty :: SummaryI
mempty = IntSet -> Int -> Double -> Average Double -> Int -> SummaryI
SummaryI IntSet
Set.empty Int
0 Double
0 (Double -> Average Double
forall a. a -> Average a
toAverage Double
0) Int
0
mappend :: SummaryI -> SummaryI -> SummaryI
mappend = SummaryI -> SummaryI -> SummaryI
forall a. Semigroup a => a -> a -> a
(<>)
summarize :: Day -> SummaryI -> Summary
summarize :: Day -> SummaryI -> Summary
summarize Day
date SummaryI{Double
Int
IntSet
Average Double
iErrors :: Int
iAverage :: Average Double
iSlowest :: Double
iUses :: Int
iUsers :: IntSet
iAverage :: SummaryI -> Average Double
iSlowest :: SummaryI -> Double
iUses :: SummaryI -> Int
iUsers :: SummaryI -> IntSet
iErrors :: SummaryI -> Int
..} = Day -> Int -> Int -> Double -> Average Double -> Int -> Summary
Summary Day
date (IntSet -> Int
Set.size IntSet
iUsers) Int
iUses Double
iSlowest Average Double
iAverage Int
iErrors
{-# NOINLINE parseLogLine #-}
parseLogLine :: (BS.ByteString -> Bool) -> BS.ByteString -> Maybe (Day, SummaryI)
parseLogLine :: (ByteString -> Bool) -> ByteString -> Maybe (Day, SummaryI)
parseLogLine ByteString -> Bool
interesting (ByteString -> [ByteString]
BS.words -> ByteString
time:ByteString
user:ByteString
dur:ByteString
query:[ByteString]
err)
| Bool
use Bool -> Bool -> Bool
|| Bool
isErr
, ByteString
user ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> ByteString
BS.singleton Char
'-'
, Just [Int
a, Int
b, Int
c] <- ([(Int, ByteString)] -> [Int])
-> Maybe [(Int, ByteString)] -> Maybe [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, ByteString) -> Int) -> [(Int, ByteString)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst) (Maybe [(Int, ByteString)] -> Maybe [Int])
-> Maybe [(Int, ByteString)] -> Maybe [Int]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Maybe (Int, ByteString))
-> [ByteString] -> Maybe [(Int, ByteString)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Maybe (Int, ByteString)
BS.readInt ([ByteString] -> Maybe [(Int, ByteString)])
-> [ByteString] -> Maybe [(Int, ByteString)]
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
BS.split Char
'-' (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BS.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'T') ByteString
time
= (Day, SummaryI) -> Maybe (Day, SummaryI)
forall a. a -> Maybe a
Just (Integer -> Int -> Int -> Day
fromGregorian (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) Int
b Int
c, IntSet -> Int -> Double -> Average Double -> Int -> SummaryI
SummaryI
(if Bool
use then Int -> IntSet
Set.singleton (Int -> IntSet) -> Int -> IntSet
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
forall a. Hashable a => a -> Int
hash ByteString
user else IntSet
Set.empty)
(if Bool
use then Int
1 else Int
0)
(if Bool
use then Double
dur2 else Double
0)
(Double -> Average Double
forall a. a -> Average a
toAverage (Double -> Average Double) -> Double -> Average Double
forall a b. (a -> b) -> a -> b
$ if Bool
use then Double
dur2 else Double
0)
(if Bool
isErr then Int
1 else Int
0))
where use :: Bool
use = ByteString -> Bool
interesting ByteString
query
isErr :: Bool
isErr = [String -> ByteString
BS.pack String
"ERROR:"] [ByteString] -> [ByteString] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [ByteString]
err
dur2 :: Double
dur2 = ByteString -> Double
parseDuration ByteString
dur
parseLogLine ByteString -> Bool
_ ByteString
_ = Maybe (Day, SummaryI)
forall a. Maybe a
Nothing
parseDuration :: BS.ByteString -> Double
parseDuration :: ByteString -> Double
parseDuration ByteString
x
| Just (Int
whole, ByteString
x) <- ByteString -> Maybe (Int, ByteString)
BS.readInt ByteString
x
= case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
x of
Just (Char
'.', ByteString
x)
| Just (Int
frac, ByteString
y) <- ByteString -> Maybe (Int, ByteString)
BS.readInt ByteString
x
-> Int -> Double
intToDouble Int
whole Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Int -> Double
intToDouble Int
frac Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
10 Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (ByteString -> Int
BS.length ByteString
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
BS.length ByteString
y)))
| Bool
otherwise -> Double
0
Maybe (Char, ByteString)
_ -> Int -> Double
intToDouble Int
whole Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000
parseDuration ByteString
_ = Double
0
logSummary :: Log -> IO [Summary]
logSummary :: Log -> IO [Summary]
logSummary Log{Maybe (Var Handle)
IORef (Map Day SummaryI)
String -> Bool
logInteresting :: String -> Bool
logCurrent :: IORef (Map Day SummaryI)
logOutput :: Maybe (Var Handle)
logInteresting :: Log -> String -> Bool
logCurrent :: Log -> IORef (Map Day SummaryI)
logOutput :: Log -> Maybe (Var Handle)
..} = ((Day, SummaryI) -> Summary) -> [(Day, SummaryI)] -> [Summary]
forall a b. (a -> b) -> [a] -> [b]
map ((Day -> SummaryI -> Summary) -> (Day, SummaryI) -> Summary
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Day -> SummaryI -> Summary
summarize) ([(Day, SummaryI)] -> [Summary])
-> (Map Day SummaryI -> [(Day, SummaryI)])
-> Map Day SummaryI
-> [Summary]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Day SummaryI -> [(Day, SummaryI)]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map Day SummaryI -> [Summary])
-> IO (Map Day SummaryI) -> IO [Summary]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map Day SummaryI) -> IO (Map Day SummaryI)
forall a. IORef a -> IO a
readIORef IORef (Map Day SummaryI)
logCurrent