-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
-- 
-- Functions running zfs processes.

module Propellor.Property.ZFS.Process where

import Propellor.Base
import Utility.Split

import Data.List

-- | Gets the properties of a ZFS volume.
zfsGetProperties ::  ZFS -> IO ZFSProperties
zfsGetProperties :: ZFS -> IO ZFSProperties
zfsGetProperties ZFS
z =
	let plist :: [[Char]] -> ZFSProperties
plist = [([Char], [Char])] -> ZFSProperties
fromPropertyList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b}. [b] -> Maybe (b, b)
parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => [a] -> [a] -> [[a]]
split [Char]
"\t"))
	in [[Char]] -> ZFSProperties
plist forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Maybe [Char]] -> ZFS -> IO [[Char]]
runZfs [Char]
"get" [forall a. a -> Maybe a
Just [Char]
"-H", forall a. a -> Maybe a
Just [Char]
"-p", forall a. a -> Maybe a
Just [Char]
"all"] ZFS
z
  where
	parse :: [b] -> Maybe (b, b)
parse (b
_:b
k:b
v:[b]
_) = forall a. a -> Maybe a
Just (b
k, b
v)
	parse [b]
_ = forall a. Maybe a
Nothing

zfsExists :: ZFS -> IO Bool
zfsExists :: ZFS -> IO Bool
zfsExists ZFS
z = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => [a] -> [a] -> Bool
isInfixOf (ZFS -> [Char]
zfsName ZFS
z))
	forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [Maybe [Char]] -> ZFS -> IO [[Char]]
runZfs [Char]
"list" [forall a. a -> Maybe a
Just [Char]
"-H"] ZFS
z

-- | Runs the zfs command with the arguments.
--
-- Runs the command with -H which will skip the header line and
-- separate all fields with tabs.
--
-- Replaces Nothing in the argument list with the ZFS pool/dataset.
runZfs :: String -> [Maybe String] -> ZFS -> IO [String]
runZfs :: [Char] -> [Maybe [Char]] -> ZFS -> IO [[Char]]
runZfs [Char]
cmd [Maybe [Char]]
args ZFS
z = [Char] -> [[Char]]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> [[Char]] -> IO [Char]
readProcess ([Char] -> [Maybe [Char]] -> ZFS -> ([Char], [[Char]])
zfsCommand [Char]
cmd [Maybe [Char]]
args ZFS
z)

-- | Return the ZFS command line suitable for readProcess or cmdProperty.
zfsCommand :: String -> [Maybe String] -> ZFS -> (String, [String])
zfsCommand :: [Char] -> [Maybe [Char]] -> ZFS -> ([Char], [[Char]])
zfsCommand [Char]
cmd [Maybe [Char]]
args ZFS
z = ([Char]
"zfs", [Char]
cmdforall a. a -> [a] -> [a]
:(forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ZFS -> [Char]
zfsName ZFS
z) forall a. a -> a
id) [Maybe [Char]]
args))