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

module Propellor.Types.ZFS where

import Data.String
import qualified Data.Set as Set
import qualified Data.String.Utils as SU
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 Show ZDataset where
  show (ZDataset paths) = intercalate "/" paths

instance IsString ZDataset where
  fromString s = ZDataset $ SU.split "/" 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)
