{-# 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

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

-- | A monad transformer encapsulating all ZFS actions.
--   Calls libzfs_init and libzfs_fini. The type parameter `z'
--   prevents the programmer from passing Zpool and Zfs handles
--   to the outside.
newtype ZfsT z m a = Zfs { runZfs' :: ZfsContext z -> m (Either ZError a) }

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

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

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

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

instance Monad m => Monad (ZfsT z 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 z 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 z m) where
  liftIO = lift . liftIO

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

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