{-# LANGUAGE RankNTypes, FlexibleContexts, TypeFamilies #-}

-- | Versioned properties and hosts.
--
-- When importing and using this module, you will need to enable some
-- language extensions:
--
-- > {-# LANGUAGE RankNTypes, FlexibleContexts, TypeFamilies #-}
--
-- This module takes advantage of `RevertableProperty` to let propellor
-- switch cleanly between versions. The way it works is all revertable
-- properties for other versions than the current version are first
-- reverted, and  then propellor ensures the property for the current
-- version. This method should work for any combination of revertable
-- properties.
--
-- For example:
-- 
-- > demo :: Versioned Int (RevertableProperty DebianLike DebianLike)
-- > demo ver =
-- > 	ver (   (== 1) --> Apache.modEnabled "foo"
-- >		`requires` Apache.modEnabled "foosupport"
-- >	    <|> (== 2) --> Apache.modEnabled "bar"
-- > 	    <|> (> 2)  --> Apache.modEnabled "baz"
-- > 	    )
-- >
-- > foo :: Host
-- > foo = host "foo.example.com" $ props
-- > 	& demo `version` (2 :: Int)
--
-- Similarly, a whole Host can be versioned. For example:
--
-- > bar :: Versioned Int Host
-- > bar ver = host "bar.example.com" $ props
-- >	& osDebian Unstable X86_64
-- > 	& ver (   (== 1) --> Apache.modEnabled "foo"
-- > 	      <|> (== 2) --> Apache.modEnabled "bar"
-- > 	      )
-- > 	& ver ( (>= 2) --> Apt.unattendedUpgrades )
--
-- Note that some versioning of revertable properties may cause
-- propellor to do a lot of unnecessary work each time it's run.
-- Here's an example of such a problem:
--
-- > slow :: Versioned Int -> RevertableProperty DebianLike DebianLike
-- > slow ver =
-- > 	ver (   (== 1) --> (Apt.installed "foo" <!> Apt.removed "foo")
-- >	    <|> (== 2) --> (Apt.installed "bar" <!> Apt.removed "bar")
-- >        )
--
-- Suppose that package bar depends on package foo. Then at version 2,
-- propellor will remove package foo in order to revert version 1, only
-- to re-install it since version 2 also needs it installed.

module Propellor.Property.Versioned (Versioned, version, (-->), (<|>)) where

import Propellor
import Propellor.Types.Core

import Data.List

-- | Something that has multiple versions of type `v`.
type Versioned v t = VersionedBy v -> t

type VersionedBy v
	= forall metatypes. Combines (RevertableProperty metatypes metatypes) (RevertableProperty metatypes metatypes)
	=> (CombinedType (RevertableProperty metatypes metatypes) (RevertableProperty metatypes metatypes) ~ RevertableProperty metatypes metatypes)
	=> (VerSpec v metatypes -> RevertableProperty metatypes metatypes)

-- | Access a particular version of a Versioned value.
version :: (Versioned v t) -> v -> t
version :: Versioned v t -> v -> t
version Versioned v t
f v
v = Versioned v t
f (v -> VerSpec v metatypes -> RevertableProperty metatypes metatypes
forall metatypes v.
(Combines
   (RevertableProperty metatypes metatypes)
   (RevertableProperty metatypes metatypes),
 CombinedType
   (RevertableProperty metatypes metatypes)
   (RevertableProperty metatypes metatypes)
 ~ RevertableProperty metatypes metatypes) =>
v -> VerSpec v metatypes -> RevertableProperty metatypes metatypes
processVerSpec v
v)

-- A specification of versions.
--
-- Why is this not a simple list like
-- [(v -> Bool, RevertableProperty metatypes metatypes)] ?
-- Using a list would mean the empty list would need to be dealt with,
-- and processVerSpec does not have a Monoid instance for
-- RevertableProperty metatypes metatypes in scope, and due to the way the
-- Versioned type works, the compiler cannot find such an instance.
--
-- Also, using this data type allows a nice syntax for creating
-- VerSpecs, via the `<&>` and `alt` functions.
data VerSpec v metatypes
	= Base (v -> Bool, RevertableProperty metatypes metatypes)
	| More (v -> Bool, RevertableProperty metatypes metatypes) (VerSpec v metatypes)

processVerSpec 
	:: Combines (RevertableProperty metatypes metatypes) (RevertableProperty metatypes metatypes)
	=> (CombinedType (RevertableProperty metatypes metatypes) (RevertableProperty metatypes metatypes) ~ RevertableProperty metatypes metatypes)
	=> v
	-> VerSpec v metatypes
	-> RevertableProperty metatypes metatypes
processVerSpec :: v -> VerSpec v metatypes -> RevertableProperty metatypes metatypes
processVerSpec v
v VerSpec v metatypes
s = VerSpec v metatypes -> RevertableProperty metatypes metatypes
combinedp VerSpec v metatypes
s
	RevertableProperty metatypes metatypes
-> Desc -> RevertableProperty metatypes metatypes
forall p. IsProp p => p -> Desc -> p
`describe` Desc -> [Desc] -> Desc
forall a. [a] -> [[a]] -> [a]
intercalate Desc
" and " (VerSpec v metatypes -> [Desc] -> [Desc]
combineddesc VerSpec v metatypes
s [])
  where
	combinedp :: VerSpec v metatypes -> RevertableProperty metatypes metatypes
combinedp (Base (v -> Bool
c, RevertableProperty metatypes metatypes
p))
		| v -> Bool
c v
v = RevertableProperty metatypes metatypes
p
		| Bool
otherwise = RevertableProperty metatypes metatypes
-> RevertableProperty metatypes metatypes
forall setup undo.
RevertableProperty setup undo -> RevertableProperty undo setup
revert RevertableProperty metatypes metatypes
p
	combinedp (More (v -> Bool
c, RevertableProperty metatypes metatypes
p) VerSpec v metatypes
vs)
		| v -> Bool
c v
v = VerSpec v metatypes -> RevertableProperty metatypes metatypes
combinedp VerSpec v metatypes
vs RevertableProperty metatypes metatypes
-> RevertableProperty metatypes metatypes
-> CombinedType
     (RevertableProperty metatypes metatypes)
     (RevertableProperty metatypes metatypes)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` RevertableProperty metatypes metatypes
p
		| Bool
otherwise = RevertableProperty metatypes metatypes
-> RevertableProperty metatypes metatypes
forall setup undo.
RevertableProperty setup undo -> RevertableProperty undo setup
revert RevertableProperty metatypes metatypes
p RevertableProperty metatypes metatypes
-> RevertableProperty metatypes metatypes
-> CombinedType
     (RevertableProperty metatypes metatypes)
     (RevertableProperty metatypes metatypes)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` VerSpec v metatypes -> RevertableProperty metatypes metatypes
combinedp VerSpec v metatypes
vs
	combineddesc :: VerSpec v metatypes -> [Desc] -> [Desc]
combineddesc (Base (v -> Bool
c, RevertableProperty metatypes metatypes
p)) [Desc]
l
		| v -> Bool
c v
v = RevertableProperty metatypes metatypes -> Desc
forall p. IsProp p => p -> Desc
getDesc RevertableProperty metatypes metatypes
p Desc -> [Desc] -> [Desc]
forall a. a -> [a] -> [a]
: [Desc]
l
		| Bool
otherwise = RevertableProperty metatypes metatypes -> Desc
forall p. IsProp p => p -> Desc
getDesc (RevertableProperty metatypes metatypes
-> RevertableProperty metatypes metatypes
forall setup undo.
RevertableProperty setup undo -> RevertableProperty undo setup
revert RevertableProperty metatypes metatypes
p) Desc -> [Desc] -> [Desc]
forall a. a -> [a] -> [a]
: [Desc]
l
	combineddesc (More (v -> Bool
c, RevertableProperty metatypes metatypes
p) VerSpec v metatypes
vs) [Desc]
l
		| v -> Bool
c v
v = RevertableProperty metatypes metatypes -> Desc
forall p. IsProp p => p -> Desc
getDesc RevertableProperty metatypes metatypes
p Desc -> [Desc] -> [Desc]
forall a. a -> [a] -> [a]
: VerSpec v metatypes -> [Desc] -> [Desc]
combineddesc VerSpec v metatypes
vs [Desc]
l
		| Bool
otherwise = RevertableProperty metatypes metatypes -> Desc
forall p. IsProp p => p -> Desc
getDesc (RevertableProperty metatypes metatypes
-> RevertableProperty metatypes metatypes
forall setup undo.
RevertableProperty setup undo -> RevertableProperty undo setup
revert RevertableProperty metatypes metatypes
p) Desc -> [Desc] -> [Desc]
forall a. a -> [a] -> [a]
: VerSpec v metatypes -> [Desc] -> [Desc]
combineddesc VerSpec v metatypes
vs [Desc]
l

-- | Specify a function that checks the version, and what
-- `RevertableProperty` to use if the version matches.
(-->) :: (v -> Bool) -> RevertableProperty metatypes metatypes -> VerSpec v metatypes
v -> Bool
c --> :: (v -> Bool)
-> RevertableProperty metatypes metatypes -> VerSpec v metatypes
--> RevertableProperty metatypes metatypes
p = (v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes
forall v metatypes.
(v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes
Base (v -> Bool
c, RevertableProperty metatypes metatypes
p)

-- | Add an alternate version.
(<|>) :: VerSpec v metatypes -> VerSpec v metatypes -> VerSpec v metatypes 
Base (v -> Bool, RevertableProperty metatypes metatypes)
a <|> :: VerSpec v metatypes -> VerSpec v metatypes -> VerSpec v metatypes
<|> Base (v -> Bool, RevertableProperty metatypes metatypes)
b = (v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
forall v metatypes.
(v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
More (v -> Bool, RevertableProperty metatypes metatypes)
a ((v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes
forall v metatypes.
(v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes
Base (v -> Bool, RevertableProperty metatypes metatypes)
b)
Base (v -> Bool, RevertableProperty metatypes metatypes)
a <|> More (v -> Bool, RevertableProperty metatypes metatypes)
b VerSpec v metatypes
c = (v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
forall v metatypes.
(v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
More (v -> Bool, RevertableProperty metatypes metatypes)
a ((v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
forall v metatypes.
(v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
More (v -> Bool, RevertableProperty metatypes metatypes)
b VerSpec v metatypes
c)
More (v -> Bool, RevertableProperty metatypes metatypes)
b VerSpec v metatypes
c <|> Base (v -> Bool, RevertableProperty metatypes metatypes)
a  = (v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
forall v metatypes.
(v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
More (v -> Bool, RevertableProperty metatypes metatypes)
a ((v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
forall v metatypes.
(v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
More (v -> Bool, RevertableProperty metatypes metatypes)
b VerSpec v metatypes
c)
More (v -> Bool, RevertableProperty metatypes metatypes)
a VerSpec v metatypes
b <|> More (v -> Bool, RevertableProperty metatypes metatypes)
c VerSpec v metatypes
d = (v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
forall v metatypes.
(v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
More (v -> Bool, RevertableProperty metatypes metatypes)
a ((v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
forall v metatypes.
(v -> Bool, RevertableProperty metatypes metatypes)
-> VerSpec v metatypes -> VerSpec v metatypes
More (v -> Bool, RevertableProperty metatypes metatypes)
c (VerSpec v metatypes
b VerSpec v metatypes -> VerSpec v metatypes -> VerSpec v metatypes
forall v metatypes.
VerSpec v metatypes -> VerSpec v metatypes -> VerSpec v metatypes
<|> VerSpec v metatypes
d))

infixl 8 -->
infixl 2 <|>