    {-# 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 :: forall v t. 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 :: 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 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 --> :: forall v metatypes.
    (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 <|> :: forall v metatypes.
    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 <|>