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