{-# LANGUAGE ConstrainedClassMethods #-}
-- | Types for ZFS Properties.
--
-- Copyright 2016 Evan Cofsky <evan@theunixman.com>
-- License: BSD 2-clause

module Propellor.Types.ZFS where

import Propellor.Types.ConfigurableValue
import Utility.Split

import Data.String
import qualified Data.Set as Set
import Data.List

-- | A single ZFS filesystem.
data ZFS = ZFS ZPool ZDataset deriving (Show, Eq, Ord)

-- | Represents a zpool.
data ZPool = ZPool String deriving (Show, Eq, Ord)

-- | Represents a dataset in a zpool.
--
-- Can be constructed from a / separated string.
data ZDataset = ZDataset [String] deriving (Eq, Ord)

type ZFSProperties = Set.Set ZFSProperty

fromList :: [ZFSProperty] -> ZFSProperties
fromList = Set.fromList

toPropertyList :: ZFSProperties -> [(String, String)]
toPropertyList = Set.foldr (\p l -> l ++ [toPair p]) []

fromPropertyList :: [(String, String)] -> ZFSProperties
fromPropertyList props =
	Set.fromList $ map fromPair props

zfsName :: ZFS -> String
zfsName (ZFS (ZPool pool) dataset) = intercalate "/" [pool, show dataset]

instance ConfigurableValue ZDataset where
	val (ZDataset paths) = intercalate "/" paths

instance Show ZDataset where
	show = val

instance IsString ZDataset where
	fromString s = ZDataset $ splitc '/' s

instance IsString ZPool where
	fromString p = ZPool p

class Value a where
	toValue :: a -> String
	fromValue :: (IsString a) => String -> a
	fromValue = fromString

data ZFSYesNo = ZFSYesNo Bool deriving (Show, Eq, Ord)
data ZFSOnOff = ZFSOnOff Bool deriving (Show, Eq, Ord)
data ZFSSize = ZFSSize Integer deriving (Show, Eq, Ord)
data ZFSString = ZFSString String deriving (Show, Eq, Ord)

instance Value ZFSYesNo where
	toValue (ZFSYesNo True) = "yes"
	toValue (ZFSYesNo False) = "no"

instance Value ZFSOnOff where
	toValue (ZFSOnOff True) = "on"
	toValue (ZFSOnOff False) = "off"

instance Value ZFSSize where
	toValue (ZFSSize s) = show s

instance Value ZFSString where
	toValue (ZFSString s) = s

instance IsString ZFSString where
	fromString = ZFSString

instance IsString ZFSYesNo where
	fromString "yes" = ZFSYesNo True
	fromString "no" = ZFSYesNo False
	fromString _ = error "Not yes or no"

instance IsString ZFSOnOff where
	fromString "on" = ZFSOnOff True
	fromString "off" = ZFSOnOff False
	fromString _ = error "Not on or off"

data ZFSACLInherit = AIDiscard | AINoAllow | AISecure | AIPassthrough deriving (Show, Eq, Ord)
instance IsString ZFSACLInherit where
	fromString "discard" = AIDiscard
	fromString "noallow" = AINoAllow
	fromString "secure" = AISecure
	fromString "passthrough" = AIPassthrough
	fromString _ = error "Not valid aclpassthrough value"

instance Value ZFSACLInherit where
	toValue AIDiscard = "discard"
	toValue AINoAllow = "noallow"
	toValue AISecure = "secure"
	toValue AIPassthrough = "passthrough"

data ZFSACLMode = AMDiscard | AMGroupmask | AMPassthrough deriving (Show, Eq, Ord)
instance IsString ZFSACLMode where
	fromString "discard" = AMDiscard
	fromString "groupmask" = AMGroupmask
	fromString "passthrough" = AMPassthrough
	fromString _ = error "Invalid zfsaclmode"

instance Value ZFSACLMode where
	toValue AMDiscard = "discard"
	toValue AMGroupmask = "groupmask"
	toValue AMPassthrough = "passthrough"

data ZFSProperty = Mounted ZFSYesNo
	       | Mountpoint ZFSString
	       | ReadOnly ZFSYesNo
	       | ACLInherit ZFSACLInherit
	       | ACLMode ZFSACLMode
	       | StringProperty String ZFSString
	       deriving (Show, Eq, Ord)

toPair :: ZFSProperty -> (String, String)
toPair (Mounted v) = ("mounted", toValue v)
toPair (Mountpoint v) = ("mountpoint", toValue v)
toPair (ReadOnly v) = ("readonly", toValue v)
toPair (ACLInherit v) = ("aclinherit", toValue v)
toPair (ACLMode v) = ("aclmode", toValue v)
toPair (StringProperty s v) = (s, toValue v)

fromPair :: (String, String) -> ZFSProperty
fromPair ("mounted", v) = Mounted (fromString v)
fromPair ("mountpoint", v) = Mountpoint (fromString v)
fromPair ("readonly", v) = ReadOnly (fromString v)
fromPair ("aclinherit", v) = ACLInherit (fromString v)
fromPair ("aclmode", v) = ACLMode (fromString v)
fromPair (s, v) = StringProperty s (fromString v)