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