{-# LANGUAGE DeriveGeneric #-}

module Log where

import Types
import Hash
import Memory
import Json

import Data.Char
import Data.Either
import Data.Time.Clock.POSIX
import qualified Data.ByteString.Lazy as L
import System.IO

-- | One item in a log of a debug-me session.
--
-- Note that the time stamp is included to allow replaying logs, but
-- it's not part of the provable session.
--
-- Note that changing this in ways that change the JSON serialization
-- changes debug-me's log file format.
data Log = Log
	{ loggedMessage :: LogMessage
	, loggedHash :: Maybe Hash
	, loggedTimestamp :: Timestamp
	}
	deriving (Show, Generic)

instance DataSize Log where
	dataSize l = dataSize (loggedMessage l)
		+ maybe 0 dataSize (loggedHash l)
		+ 2

instance ToJSON Log
instance FromJSON Log

data LogMessage
	= User (Message Seen)
	| Developer (Message Entered)
	deriving (Show, Generic)

instance DataSize LogMessage where
	dataSize (User a) = dataSize a
	dataSize (Developer a) = dataSize a

instance ToJSON LogMessage where
	toJSON = genericToJSON sumOptions
	toEncoding = genericToEncoding sumOptions
instance FromJSON LogMessage where
	parseJSON = genericParseJSON sumOptions

mkLog :: LogMessage -> POSIXTime -> Log
mkLog m now = Log
	{ loggedMessage = m
	, loggedHash = case m of
		User (ActivityMessage a) -> Just (hash a)
		Developer (ActivityMessage a) -> Just (hash a)
		User (ControlMessage _) -> Nothing
		Developer (ControlMessage _) -> Nothing
	, loggedTimestamp = now
	}

type Timestamp = POSIXTime

type Logger = LogMessage -> IO ()

withLogger :: FilePath -> (Logger -> IO a) -> IO a
withLogger logfile a = withFile logfile WriteMode (a . mkLogger)

mkLogger :: Handle -> Logger
mkLogger h a = do
	l <- mkLog a <$> getPOSIXTime
	L.hPut h (encode l)
	hPutStr h "\n"
	hFlush h

parseLog :: L.ByteString -> [Either String Log]
parseLog = map eitherDecode' 
	. filter (not . L.null)
	. L.split (fromIntegral (ord '\n'))

-- | Throws exception on unparsable log.
loadLog :: FilePath -> IO [Log]
loadLog f = do
	parsed <- parseLog <$> L.readFile f
	case lefts parsed of
		[] -> return (rights parsed)
		errs -> error $ unlines errs