    {-# 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 Safe
    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 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; pure $ Log Nothing ref (const 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
        (h, old) <- case Either Handle String
    store of
            Left Handle
    h -> (Handle, Map Day SummaryI) -> IO (Handle, Map Day SummaryI)
    forall a. a -> IO a
    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
                b <- String -> IO Bool
    doesFileExist String
    file
                mp <- if not b then pure Map.empty else withFile file ReadMode $ \Handle
    h -> do
                    src <- Handle -> IO ByteString
    LBS.hGetContents Handle
    h
                    let 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
                    pure $! 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.empty xs
                (,mp) <$> openFile file AppendMode
        hSetBuffering h LineBuffering
        var <- newVar h
        ref <- newIORef old
        pure $ Log (Just var) ref (interesting . BS.pack)

    logAddMessage :: Log -> String -> IO ()
    logAddMessage :: Log -> String -> IO ()
    logAddMessage Log{Maybe (Var Handle)
    IORef (Map Day SummaryI)
    String -> Bool
    logOutput :: Log -> Maybe (Var Handle)
    logCurrent :: Log -> IORef (Map Day SummaryI)
    logInteresting :: Log -> String -> Bool
    logOutput :: Maybe (Var Handle)
    logCurrent :: IORef (Map Day SummaryI)
    logInteresting :: String -> Bool
    ..} String
    msg = do
        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
        whenJust logOutput $ \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
    logOutput :: Log -> Maybe (Var Handle)
    logCurrent :: Log -> IORef (Map Day SummaryI)
    logInteresting :: Log -> String -> Bool
    logOutput :: Maybe (Var Handle)
    logCurrent :: IORef (Map Day SummaryI)
    logInteresting :: String -> Bool
    ..} String
    user String
    question Double
    taken Maybe String
    err = do
        time <- IO UTCTime
    getCurrentTime
        let 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 logInteresting question then
            add $ SummaryI (Set.singleton $ hash $ LBS.pack user) 1 taken (toAverage taken) (if isJust err then 1 else 0)
         else if isJust err then
            add mempty{iErrors=1}
         else
            pure ()
        whenJust logOutput $ \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 a b. (a -> b) -> Maybe a -> Maybe b
    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)

    -- Summary collapsed
    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
        }

    -- Summary accumulating
    data SummaryI = SummaryI
        {SummaryI -> IntSet
    iUsers :: !Set.IntSet -- number of distinct users
        ,SummaryI -> Int
    iUses :: !Int -- number of uses
        ,SummaryI -> Double
    iSlowest :: !Double -- slowest result
        ,SummaryI -> Average Double
    iAverage :: !(Average Double) -- average result
        ,SummaryI -> Int
    iErrors :: !Int -- number of errors
        }

    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)
            -- more efficient union for the very common case of a single element
            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. Partial => [a] -> a
    headErr ([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. Partial => [a] -> a
    headErr ([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 :: SummaryI -> Int
    iUsers :: SummaryI -> IntSet
    iUses :: SummaryI -> Int
    iSlowest :: SummaryI -> Double
    iAverage :: SummaryI -> Average Double
    iUsers :: IntSet
    iUses :: Int
    iSlowest :: Double
    iAverage :: Average Double
    iErrors :: 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

    -- This noinline solves a massive memory leak at -O2, and I have no idea why
    {-# 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 a b. (a -> b) -> Maybe a -> Maybe b
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 (Year -> Int -> Int -> Day
    fromGregorian (Int -> Year
    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

    -- Hoogle used to store whole numbers of milliseconds, then it switched to 4dp doubles with a guaranteed '.'
    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
    logOutput :: Log -> Maybe (Var Handle)
    logCurrent :: Log -> IORef (Map Day SummaryI)
    logInteresting :: Log -> String -> Bool
    logOutput :: Maybe (Var Handle)
    logCurrent :: IORef (Map Day SummaryI)
    logInteresting :: String -> Bool
    ..} = ((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