{-# LANGUAGE MultiParamTypeClasses, RankNTypes #-}

module System.Zfs.Types where

import Control.Applicative
import Control.Monad
import Control.Monad.Except
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import qualified System.Zfs.Lowlevel as L
import System.Zfs.Errors
import Foreign.ForeignPtr
import Foreign.Ptr

-- | Libzfs context (hidden)
newtype ZfsContext = ZfsContext (ForeignPtr L.LibzfsHandle)
-- | A Zpool handle
newtype Zpool = Zpool (ForeignPtr L.ZpoolHandle)
-- | A Zfs handle
newtype Zdataset = Zdataset (ForeignPtr L.ZfsHandle)

-- | A monad transformer encapsulating all ZFS actions.
--   Calls libzfs_init and libzfs_fini.
newtype ZfsT m a = Zfs { runZfs' :: ZfsContext -> m (Either ZError a) }

-- | Some Zfs function that works for all underlying MonadIO instances
type Zfs a = forall m. MonadIO m => ZfsT m a

-- | A Zpool device
data Vdev = VdFile String
          | VdMirror [Vdev]
          deriving (Eq, Show)

instance Monad m => Functor (ZfsT m) where
  fmap = liftM

instance Monad m => Applicative (ZfsT m) where
  (<*>) = ap
  pure = return

instance Monad m => Monad (ZfsT m) where
  return = Zfs . const . return . Right
  m >>= f = Zfs $ \z -> do
    a <- runZfs' m z
    case a of
      Right a' -> runZfs' (f a') z
      Left e -> return $ Left e

instance Monad m => MonadError ZError (ZfsT m) where
  throwError e = Zfs $ \_ -> return $ Left e
  m `catchError` f = Zfs $ \z -> do
    a <- runZfs' m z
    case a of
      Right _ -> return a
      Left e -> runZfs' (f e) z

instance MonadIO m => MonadIO (ZfsT m) where
  liftIO = lift . liftIO

instance MonadTrans ZfsT where
  lift m = Zfs $ \_ -> liftM Right m

data ZpoolConfig = ZpoolConfig {
  zpVersion :: Integer,
  zpName :: String,
  zpState :: Integer, -- TODO
  zpGuid :: Integer,
  zpHostname :: String
  } deriving (Read,Show)

withZfs :: MonadIO m => (Ptr L.LibzfsHandle -> IO (Either ZError a)) -> ZfsT m a
withZfs f = Zfs $ \(ZfsContext fz) ->
            liftIO $ withForeignPtr fz $ \z -> f z