{-# LANGUAGE ScopedTypeVariables #-}

module Network.Metaverse.Utils where

import Control.Concurrent
import Control.Monad

import Control.Event.Relative

import Data.Word
import Data.Char
import Data.List

import qualified Data.Map as M

import System.Random

------------------------------------------------------------------------

{-
    Random utilities useful for purpose or another.
-}

lookupIndex :: Eq a => a -> [(a,b)] -> Maybe Int
lookupIndex a xs = go 0 a xs
    where go n a [] = Nothing
          go n a ((x,y):zs) | a == x    = Just n
                            | otherwise = go (n+1) a zs

dropAt _ []     = []
dropAt 0 (x:xs) = xs
dropAt n (x:xs) = x : dropAt (n-1) xs

toHexString :: [Word8] -> String
toHexString = concatMap toHex
    where toHex n    = [ hexDigit (n `div` 16), hexDigit (n `mod` 16) ]
          hexDigit d | d < 10    = chr (ord '0' + fromIntegral d)
                     | otherwise = chr (ord 'a' + fromIntegral d - 10)

------------------------------------------------------------------------

{-
    UUID Stuff.  UUIDs are used throughout SL, so this code provides a
    simple way to interact with them.
-}

newtype UUID = UUID [Word8] deriving (Eq, Ord)

randomUUID :: IO UUID
randomUUID = fmap UUID $ replicateM 16 $ fmap fromIntegral
    $ randomRIO (0 :: Int, 255 :: Int)

zeroUUID :: UUID
zeroUUID = UUID (replicate 16 0)

instance Show UUID where
    show (UUID xs) = let (a,xs1) = splitAt 4 xs
                         (b,xs2) = splitAt 2 xs1
                         (c,xs3) = splitAt 2 xs2
                         (d,e  ) = splitAt 2 xs3
                     in  intercalate "-" $ map toHexString [a,b,c,d,e]

instance Read UUID where
    readsPrec _ s = let (p,r) = splitAt 36 s
                    in [ (UUID $ toBytes $ filter (/= '-') p, r) ]
        where toBytes []       = []
              toBytes (a:b:ss) = (16 * digit a + digit b) : toBytes ss
              digit '0'        = 0  ;   digit '1'        = 1
              digit '2'        = 2  ;   digit '3'        = 3
              digit '4'        = 4  ;   digit '5'        = 5
              digit '6'        = 6  ;   digit '7'        = 7
              digit '8'        = 8  ;   digit '9'        = 9
              digit 'a'        = 10 ;   digit 'b'        = 11
              digit 'c'        = 12 ;   digit 'd'        = 13
              digit 'e'        = 14 ;   digit 'f'        = 15

------------------------------------------------------------------------

{-
    A wrapper for Control.Event.Relative, except that instead of returning
    an EventId when scheduling an event, the user supplies the event
    identifier as an ordered type of their own choosing.
-}
data TaskQueue k = TaskQueue {
    taskVar :: MVar (M.Map k EventId)
    }

newTaskQueue :: Ord k => IO (TaskQueue k)
newTaskQueue = fmap TaskQueue (newMVar M.empty)

schedule :: Ord k => TaskQueue k -> k -> Int -> IO () -> IO ()
schedule (TaskQueue v) k t a = do
    id <- addEvent t $ modifyMVar_ v (return . M.delete k) >> a
    modifyMVar_ v (return . M.insert k id)

cancel   :: Ord k => TaskQueue k -> k -> IO Bool
cancel (TaskQueue v) k = do
    m <- takeMVar v
    case M.lookup k m of Nothing -> putMVar v m >> return False
                         Just id -> putMVar v (M.delete k m) >> delEvent id >> return True

------------------------------------------------------------------------