{-# 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
import Foreign.Marshal.Array

-- | Runs some ZfsT function, making sure that no Zpool or Zfs handles
--   are passed to the outside. Calls libzfs_init and libzfs_fini.
runZfs :: MonadIO m => (forall z. ZfsT z m a) -> m (Either ZError a)
runZfs m = do
  lzh <- liftIO L.libzfs_init
  if lzh == nullPtr
    then return $ Left EzInitFailed
    else do
    a <- runZfs' m $ ZfsContext lzh
    liftIO $ L.libzfs_fini lzh
    return a

-- | Print Zpool config (primarily for debugging purposes)
printZpoolConfig :: Zpool z -> Zfs z ()
printZpoolConfig p@(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
  p `seq` fptr `seq` 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 "}"
              20 -> alloca $ \ptr -> alloca $ \szptr -> do
                L.nvlist_lookup_nvlist_array nvl cstr ptr szptr
                sz <- peek szptr
                arr <- peek ptr
                putStrLn " ["
                as <- peekArray (fromIntegral sz) arr
                forM_ as $ \a -> do
                  putStr " * "
                  process a nullPtr
                putStrLn "]"
              _ -> return ()
            putStrLn ""
            process nvl nvp'