{-# LANGUAGE BangPatterns #-}
module DarkPlaces.DemoMetadata (
    DemoMetadata(..),
    MetadataList,
    getMetadata,
    getMapname
) where
import Data.Maybe
import Control.Applicative
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import Text.Regex.TDFA
import DarkPlaces.PacketParser
import DarkPlaces.Demo (demoFilePackets)
import DarkPlaces.Types (ErrorInfo)


data DemoMetadata = MapName String
                  | DemoTime Float
                  | DemoMessage Float BL.ByteString
                  | CurlDownload BL.ByteString BL.ByteString BL.ByteString -- fields: as for url
    deriving(Show, Eq)


type MetadataList = [DemoMetadata]


data DTimeState = DTimeBegin
                | DTimeState Float Float
    deriving(Show, Eq)


timeInit :: DTimeState
timeInit = DTimeBegin

timeUpdate :: DPServerPacket -> DTimeState -> DTimeState
timeUpdate (DPTime x) DTimeBegin = DTimeState x 0
timeUpdate (DPTime x) (DTimeState b _) = DTimeState b x
timeUpdate _ s = s

timeMetadata :: DTimeState -> MetadataList
timeMetadata (DTimeState b e) = [DemoTime (e - b)]
timeMetadata _ = []

timeValue :: DTimeState -> Float
timeValue (DTimeState b e) = e - b
timeValue _ = 0

removePrefix :: BL.ByteString -> BL.ByteString -> Maybe BL.ByteString
removePrefix pref text = if matched then Just removed else Nothing
  where
    pl = BL.length pref
    matched = BL.isPrefixOf pref text
    removed = BL.drop pl text


removeSuffix :: BL.ByteString -> BL.ByteString -> Maybe BL.ByteString
removeSuffix suf text = if matched then Just removed else Nothing
  where
    text_len = BL.length text
    suf_len = BL.length suf
    matched = BL.isSuffixOf suf text
    removed = BL.take (text_len - suf_len) text


removePrefixSuffix :: BL.ByteString -> BL.ByteString -> BL.ByteString -> Maybe BL.ByteString
removePrefixSuffix pref suf text = removePrefix pref text >>= removeSuffix suf


mapName :: BL.ByteString -> Maybe BL.ByteString
mapName model = removePrefixSuffix map_prefix map_suffix model
  where
    map_suffix = BLC.pack ".bsp"
    map_prefix = BLC.pack "maps/"


detectMapName :: DPServerPacket -> MetadataList
detectMapName (DPServerInfo (Right p@(DPServerInfoData {}))) = if not empty
        then map MapName map_names
        else []
  where
    models = dpmodelsPrecached p
    empty = null models
    map_names = maybeToList $ BLC.unpack <$> mapName (head models)

detectMapName _ = []


detectDemoMessage :: DPServerPacket -> Float -> MetadataList
detectDemoMessage (DPPrint p) t = [DemoMessage t p]
detectDemoMessage _ _ = []


detectCurlDownload :: DPServerPacket -> MetadataList
detectCurlDownload (DPStuffText t) = getCurlDownload t
  where
    curlRegex = makeRegex "^curl.*\\-\\-as ([^ ]+) \\-\\-for ([^ ]+) ([^ ]+)" :: Regex
    matchCurl s = match curlRegex s :: (BL.ByteString, BL.ByteString, BL.ByteString, [BL.ByteString])
    getCurlDownload s = case matchCurl s of
        (_, mt, a, [as, for, url]) | not (BL.null mt) -> (CurlDownload as for url) : getCurlDownload a
        _ -> []

detectCurlDownload _ = []


getMetadata :: BL.ByteString -> [Either ErrorInfo DemoMetadata]
getMetadata file_data = go (demoFilePackets file_data) timeInit
  where
    go ((Left x):_) _ = [Left x]
    go ((Right (Right x)):xs) !s = addSimpleMetadata x s ++ go xs (timeUpdate x s)
    go ((Right (Left _)):xs) !s = go xs s
    go [] s = Right <$> timeMetadata s
    addSimpleMetadata x s = Right <$> (detectMapName x ++ detectCurlDownload x ++ (detectDemoMessage x $ timeValue s))


getMapname :: BL.ByteString -> Either ErrorInfo (Maybe String)
getMapname file_data = go (demoFilePackets file_data)
  where
    go ((Left x):_) = Left x
    go ((Right (Right x)):xs) = if not (null mapList) then Right $ maybeMap mapList else go xs
      where
        mapList = detectMapName x
        maybeMap [MapName m] = Just m
        maybeMap _ = Nothing

    go ((Right (Left _)):xs) = go xs
    go [] = Right Nothing