{-# LANGUAGE ExplicitForAll, RankNTypes, ScopedTypeVariables #-}

module System.Zfs (
  module System.Zfs.Errors,
  module System.Zfs.Types,
  module System.Zfs.Zpool,
  module System.Zfs.Mount,
  module System.Zfs.Iter,
  module System.Zfs.Dataset,
  runZfs,
  printZpoolConfig
  ) where

import Control.Monad
import Control.Monad.IO.Class
import qualified System.Zfs.Lowlevel as L
import System.Zfs.Errors
import System.Zfs.Types
import System.Zfs.Zpool
import System.Zfs.Mount
import System.Zfs.Iter
import System.Zfs.Dataset
import Foreign.ForeignPtr
import Foreign.StablePtr
import Foreign.C.String
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc

-- | Runs some ZfsT function. Calls libzfs_init and libzfs_fini.
runZfs :: MonadIO m => ZfsT m a -> m (Either ZError a)
runZfs m = do
  lzh <- liftIO L.libzfs_init
  if lzh == nullPtr
    then return $ Left EzInitFailed
    else do
      fptr <- liftIO $ newForeignPtr L.libzfs_fini_ lzh
      a <- runZfs' m $ ZfsContext fptr
      return a

-- | Print Zpool config
printZpoolConfig :: Zpool -> Zfs ()
printZpoolConfig (Zpool fptr) = Zfs $ \_ -> liftIO $ do
  nvl <- withForeignPtr fptr $ \ptr -> L.zpool_get_config ptr nullPtr
  process nvl nullPtr
  liftIO $ putStrLn " [ features ]"
  nvl <- withForeignPtr fptr $ \ptr -> L.zpool_get_features ptr
  process nvl nullPtr
  return $ Right ()
  where process nvl nvp = do
          nvp' <- L.nvlist_next_nvpair nvl nvp
          if nvp' == nullPtr
            then return ()
            else do
            cstr <- L.nvpair_name nvp'
            peekCString cstr >>= putStr
            dt <- L.nvpair_type nvp'
            putStr (" ("++show dt++")")
            case dt of
              8 -> alloca $ \ptr -> do
                L.nvlist_lookup_uint64 nvl cstr ptr
                i <- peek ptr
                putStr $ show i
              9 -> alloca $ \ptr -> do
                L.nvlist_lookup_string nvl cstr ptr
                cs <- peek ptr
                peekCString cs >>= putStr
              19 -> alloca $ \ptr -> do
                L.nvlist_lookup_nvlist nvl cstr ptr
                nvl' <- peek ptr
                putStrLn " {"
                process nvl' nullPtr
                putStrLn "}"
              _ -> return ()
            putStrLn ""
            process nvl nvp'