{-# LANGUAGE FlexibleContexts #-}

module Network.NineP.Internal.State
        ( Nine
        , NineVersion(..)
        , readVersion
        , Config(..)
        , NineState(..)
        , emptyState
        , lookup
        , insert
        , delete
        , iounit
        , call
        ) where

import Control.Concurrent.Async
import Control.Concurrent.MState
import Control.Exception (throw)
import Control.Exception.Peel as P
import Control.Monad.Catch
import Control.Monad.EmbedIO
import Control.Monad.IO.Peel
import Control.Monad.Reader
import Control.Monad.State.Class
import Data.List (isPrefixOf)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Word
import Prelude hiding (lookup)

import Network.NineP.Error
import Network.NineP.Internal.File

data NineVersion = VerUnknown | Ver9P2000

instance Show NineVersion where
        show VerUnknown = "unknown"
        show Ver9P2000 = "9P2000"

readVersion :: String -> NineVersion
readVersion s = if isPrefixOf "9P2000" s then Ver9P2000 else VerUnknown

-- |Server configuration.
data Config m = Config {
                -- |The @/@ directory of the hosted filesystem.
                root :: NineFile m,
                -- |The listening address. The syntax is taken from @Plan 9@ operating system and has the form @unix!\/path\/to\/socket@ for unix socket files, and @tcp!hostname!port@ for tcp sockets.
                addr :: String,
                -- |The initial state for the user-supplied monad. Use 'Void' for 'IO'.
                monadState :: Content m
        }

data NineState m = NineState {
                fidMap :: Map Word32 (NineFile m),
                flushMap :: Map Word16 (IO ()),
                msize :: Word32,
                protoVersion :: NineVersion,
                mState :: Content m
        }

emptyState m = NineState {
        fidMap = M.empty :: Map Word32 (NineFile m),
        flushMap = M.empty :: Map Word16 (IO ()),
        msize = 0,
        protoVersion = VerUnknown,
        mState = m
}

type Nine m x = MState (NineState m) (ReaderT (Config m) IO) x

instance MonadThrow m => MonadThrow (MState s m) where
        throwM e = lift $ throwM e
instance (MonadCatch m, MonadPeelIO m) => MonadCatch (MState s m) where
        catch = P.catch

call :: (EmbedIO m) => Word16 -> m a -> MState (NineState m) (ReaderT (Config m) IO) a
call tag x = do
        s <- (return . mState) =<< get
        thread <- liftIO $ async $ callback x s
        flushable tag thread
        lift $ lift $ wait thread

lookup :: Word32 -> Nine m (NineFile m)
lookup fid = do
        m <- (return . fidMap) =<< get
        case M.lookup fid m of
                Nothing -> throw $ ENoFid fid
                Just f -> return f

insert :: Word32 -> NineFile m -> Nine m ()
insert fid f = do
        m <- (return . fidMap) =<< get
        modifyM_ (\s -> s { fidMap = M.insert fid f $ fidMap s })

delete :: Word32 -> Nine m ()
delete fid = do
        modifyM_ (\s -> s { fidMap = M.delete fid $ fidMap s })

iounit :: Nine m Word32
iounit = do
        ms <- (return . msize) =<< get
        -- 23 is the biggest size of a message (write), but libixp uses 24, so we do too to stay safe
        return $ ms - 24

flushable :: Word16 -> Async a -> Nine m ()
flushable tag thread = modifyM_ (\s -> s { flushMap = M.insert tag (cancel thread) $ flushMap s })

flush :: Word16 -> Nine m ()
flush tag = do
        m <- (return . flushMap) =<< get
        case M.lookup tag m of
                Nothing -> return ()
                Just handler -> lift $ lift handler