{-# LANGUAGE PackageImports #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Propellor.Types
	( Host(..)
	, Property
	, Info
	, HasInfo
	, NoInfo
	, CInfo
	, Desc
	, infoProperty
	, simpleProperty
	, adjustPropertySatisfy
	, propertyInfo
	, propertyDesc
	, propertyChildren
	, RevertableProperty(..)
	, MkRevertableProperty(..)
	, IsProp(..)
	, Combines(..)
	, CombinedType
	, ResultCombiner
	, Propellor(..)
	, LiftPropellor(..)
	, EndAction(..)
	, module Propellor.Types.OS
	, module Propellor.Types.Dns
	, module Propellor.Types.Result
	, propertySatisfy
	, ignoreInfo
	) where

import Data.Monoid
import Control.Applicative
import "mtl" Control.Monad.RWS.Strict
import Control.Monad.Catch
import Data.Typeable

import Propellor.Types.Info
import Propellor.Types.OS
import Propellor.Types.Dns
import Propellor.Types.Result

-- | Everything Propellor knows about a system: Its hostname,
-- properties and their collected info.
data Host = Host
	{ hostName :: HostName
	, hostProperties :: [Property HasInfo]
	, hostInfo :: Info
	}
	deriving (Show, Typeable)

-- | Propellor's monad provides read-only access to info about the host
-- it's running on, and a writer to accumulate EndActions.
newtype Propellor p = Propellor { runWithHost :: RWST Host [EndAction] () IO p }
	deriving
		( Monad
		, Functor
		, Applicative
		, MonadReader Host
		, MonadWriter [EndAction]
		, MonadIO
		, MonadCatch
		, MonadThrow
		, MonadMask
		)

class LiftPropellor m where
	liftPropellor :: m a -> Propellor a

instance LiftPropellor Propellor where
	liftPropellor = id

instance LiftPropellor IO where
	liftPropellor = liftIO

instance Monoid (Propellor Result) where
	mempty = return NoChange
	-- | The second action is only run if the first action does not fail.
	mappend x y = do
		rx <- x
		case rx of
			FailedChange -> return FailedChange
			_ -> do
				ry <- y
				return (rx <> ry)

-- | An action that Propellor runs at the end, after trying to satisfy all
-- properties. It's passed the combined Result of the entire Propellor run.
data EndAction = EndAction Desc (Result -> Propellor Result)

type Desc = String

-- | The core data type of Propellor, this represents a property
-- that the system should have, and an action to ensure it has the
-- property.
--
-- A property can have associated `Info` or not. This is tracked at the
-- type level with Property `NoInfo` and Property `HasInfo`.
--
-- There are many instances and type families, which are mostly used
-- internally, so you needn't worry about them.
data Property i where
	IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo
	SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo

-- | Indicates that a Property has associated Info.
data HasInfo
-- | Indicates that a Property does not have Info.
data NoInfo

-- | Type level calculation of the combination of HasInfo and/or NoInfo
type family CInfo x y
type instance CInfo HasInfo HasInfo = HasInfo
type instance CInfo HasInfo NoInfo = HasInfo
type instance CInfo NoInfo HasInfo = HasInfo
type instance CInfo NoInfo NoInfo = NoInfo

-- | Constructs a Property with associated Info.
infoProperty 
	:: Desc -- ^ description of the property
	-> Propellor Result -- ^ action to run to satisfy the property (must be idempotent; may run repeatedly)
	-> Info -- ^ info associated with the property
	-> [Property i] -- ^ child properties
	-> Property HasInfo
infoProperty d a i cs = IProperty d a i (map toIProperty cs)

-- | Constructs a Property with no Info.
simpleProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo
simpleProperty = SProperty

toIProperty :: Property i -> Property HasInfo
toIProperty p@(IProperty {}) = p
toIProperty (SProperty d s cs) = IProperty d s mempty (map toIProperty cs)

toSProperty :: Property i -> Property NoInfo
toSProperty (IProperty d s _ cs) = SProperty d s (map toSProperty cs)
toSProperty p@(SProperty {}) = p

-- | Makes a version of a Proprty without its Info.
-- Use with caution!
ignoreInfo :: Property i -> Property NoInfo
ignoreInfo = toSProperty

-- | Gets the action that can be run to satisfy a Property.
-- You should never run this action directly. Use
-- 'Propellor.Engine.ensureProperty` instead.
propertySatisfy :: Property i -> Propellor Result
propertySatisfy (IProperty _ a _ _) = a
propertySatisfy (SProperty _ a _) = a

-- | Changes the action that is performed to satisfy a property. 
adjustPropertySatisfy :: Property i -> (Propellor Result -> Propellor Result) -> Property i
adjustPropertySatisfy (IProperty d s i cs) f = IProperty d (f s) i cs
adjustPropertySatisfy (SProperty d s cs) f = SProperty d (f s) cs

propertyInfo :: Property i -> Info
propertyInfo (IProperty _ _ i _) = i
propertyInfo (SProperty {}) = mempty

propertyDesc :: Property i -> Desc
propertyDesc (IProperty d _ _ _) = d
propertyDesc (SProperty d _ _) = d

instance Show (Property i) where
        show p = "property " ++ show (propertyDesc p)

-- | A Property can include a list of child properties that it also
-- satisfies. This allows them to be introspected to collect their info, etc.
propertyChildren :: Property i -> [Property i]
propertyChildren (IProperty _ _ _ cs) = cs
propertyChildren (SProperty _ _ cs) = cs

-- | A property that can be reverted. The first Property is run
-- normally and the second is run when it's reverted.
data RevertableProperty i = RevertableProperty (Property i) (Property i)

instance Show (RevertableProperty i) where
        show (RevertableProperty p _) = show p

class MkRevertableProperty i1 i2 where
	-- | Shorthand to construct a revertable property.
	(<!>) :: Property i1 -> Property i2 -> RevertableProperty (CInfo i1 i2)

instance MkRevertableProperty HasInfo HasInfo where
	x <!> y = RevertableProperty x y
instance MkRevertableProperty NoInfo NoInfo where
	x <!> y = RevertableProperty x y
instance MkRevertableProperty NoInfo HasInfo where
	x <!> y = RevertableProperty (toProp x) y
instance MkRevertableProperty HasInfo NoInfo where
	x <!> y = RevertableProperty x (toProp y)

-- | Class of types that can be used as properties of a host.
class IsProp p where
	setDesc :: p -> Desc -> p
	toProp :: p -> Property HasInfo
	getDesc :: p -> Desc
	-- | Gets the info of the property, combined with all info
	-- of all children properties.
	getInfoRecursive :: p -> Info

instance IsProp (Property HasInfo) where
	setDesc (IProperty _ a i cs) d = IProperty d a i cs
	toProp = id
	getDesc = propertyDesc
	getInfoRecursive (IProperty _ _ i cs) = 
		i <> mconcat (map getInfoRecursive cs)
instance IsProp (Property NoInfo) where
	setDesc (SProperty _ a cs) d = SProperty d a cs
	toProp = toIProperty
	getDesc = propertyDesc
	getInfoRecursive _ = mempty

instance IsProp (RevertableProperty HasInfo) where
	setDesc = setDescR
	getDesc (RevertableProperty p1 _) = getDesc p1
	toProp (RevertableProperty p1 _) = p1
	-- | Return the Info of the currently active side.
	getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1
instance IsProp (RevertableProperty NoInfo) where
	setDesc = setDescR
	getDesc (RevertableProperty p1 _) = getDesc p1
	toProp (RevertableProperty p1 _) = toProp p1
	getInfoRecursive (RevertableProperty _ _) = mempty

-- | Sets the description of both sides.
setDescR :: IsProp (Property i) => RevertableProperty i -> Desc -> RevertableProperty i
setDescR (RevertableProperty p1 p2) d =
	RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d))

-- | Type level calculation of the type that results from combining two
-- types of properties.
type family CombinedType x y
type instance CombinedType (Property x) (Property y) = Property (CInfo x y)
type instance CombinedType (RevertableProperty x) (RevertableProperty y) = RevertableProperty (CInfo x y)
-- When only one of the properties is revertable, the combined property is
-- not fully revertable, so is not a RevertableProperty.
type instance CombinedType (RevertableProperty x) (Property y) = Property (CInfo x y)
type instance CombinedType (Property x) (RevertableProperty y) = Property (CInfo x y)

type ResultCombiner = Propellor Result -> Propellor Result -> Propellor Result

class Combines x y where
	-- | Combines together two properties, yielding a property that
	-- has the description and info of the first, and that has the second
	-- property as a child. 
	combineWith 
		:: ResultCombiner
		-- ^ How to combine the actions to satisfy the properties.
		-> ResultCombiner
		-- ^ Used when combining revertable properties, to combine
		-- their reversion actions.
		-> x
		-> y
		-> CombinedType x y

instance Combines (Property HasInfo) (Property HasInfo) where
	combineWith f _ (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
		IProperty d1 (f a1 a2) i1 (y : cs1)

instance Combines (Property HasInfo) (Property NoInfo) where
	combineWith f _ (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =
		IProperty d1 (f a1 a2) i1 (toIProperty y : cs1)

instance Combines (Property NoInfo) (Property HasInfo) where
	combineWith f _ (SProperty d1 a1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =
		IProperty d1 (f a1 a2) mempty (y : map toIProperty cs1)

instance Combines (Property NoInfo) (Property NoInfo) where
	combineWith f _ (SProperty d1 a1  cs1) y@(SProperty _d2 a2 _cs2) =
		SProperty d1 (f a1 a2) (y : cs1)

instance Combines (RevertableProperty NoInfo) (RevertableProperty NoInfo) where
	combineWith = combineWithRR
instance Combines (RevertableProperty HasInfo) (RevertableProperty HasInfo) where
	combineWith = combineWithRR
instance Combines (RevertableProperty HasInfo) (RevertableProperty NoInfo) where
	combineWith = combineWithRR
instance Combines (RevertableProperty NoInfo) (RevertableProperty HasInfo) where
	combineWith = combineWithRR
instance Combines (RevertableProperty NoInfo) (Property HasInfo) where
	combineWith = combineWithRP
instance Combines (RevertableProperty NoInfo) (Property NoInfo) where
	combineWith = combineWithRP
instance Combines (RevertableProperty HasInfo) (Property HasInfo) where
	combineWith = combineWithRP
instance Combines (RevertableProperty HasInfo) (Property NoInfo) where
	combineWith = combineWithRP
instance Combines (Property HasInfo) (RevertableProperty NoInfo) where
	combineWith = combineWithPR
instance Combines (Property NoInfo) (RevertableProperty NoInfo) where
	combineWith = combineWithPR
instance Combines (Property HasInfo) (RevertableProperty HasInfo) where
	combineWith = combineWithPR
instance Combines (Property NoInfo) (RevertableProperty HasInfo) where
	combineWith = combineWithPR

combineWithRR 
	:: Combines (Property x) (Property y)
	=> ResultCombiner
	-> ResultCombiner
	-> RevertableProperty x
	-> RevertableProperty y
	-> RevertableProperty (CInfo x y)
combineWithRR sf tf (RevertableProperty s1 t1) (RevertableProperty s2 t2) =
	RevertableProperty
		(combineWith sf tf s1 s2)
		(combineWith tf sf t1 t2)

combineWithRP
	:: Combines (Property i) y
	=> (Propellor Result -> Propellor Result -> Propellor Result)
	-> (Propellor Result -> Propellor Result -> Propellor Result)
	-> RevertableProperty i
	-> y
	-> CombinedType (Property i) y
combineWithRP sf tf (RevertableProperty x _) y = combineWith sf tf x y

combineWithPR
	:: Combines x (Property i)
	=> (Propellor Result -> Propellor Result -> Propellor Result)
	-> (Propellor Result -> Propellor Result -> Propellor Result)
	-> x
	-> RevertableProperty i
	-> CombinedType x (Property i)
combineWithPR sf tf x (RevertableProperty y _) = combineWith sf tf x y