{-# LANGUAGE GADTs, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

module Propellor.Types.Info (
	Info(..),
	InfoEntry(..),
	IsInfo(..),
	PropagateInfo(..),
	addInfo,
	toInfo,
	fromInfo,
	mapInfo,
	InfoVal(..),
	fromInfoVal,
	Typeable,
) where

import Data.Dynamic
import Data.Maybe
import Data.Monoid
import qualified Data.Semigroup as Sem
import qualified Data.Typeable as T
import Prelude

-- | Information about a Host, which can be provided by its properties.
--
-- Many different types of data can be contained in the same Info value
-- at the same time. See `toInfo` and `fromInfo`.
newtype Info = Info [InfoEntry]
	deriving (NonEmpty Info -> Info
Info -> Info -> Info
forall b. Integral b => b -> Info -> Info
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Info -> Info
$cstimes :: forall b. Integral b => b -> Info -> Info
sconcat :: NonEmpty Info -> Info
$csconcat :: NonEmpty Info -> Info
<> :: Info -> Info -> Info
$c<> :: Info -> Info -> Info
Sem.Semigroup, Semigroup Info
Info
[Info] -> Info
Info -> Info -> Info
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Info] -> Info
$cmconcat :: [Info] -> Info
mappend :: Info -> Info -> Info
$cmappend :: Info -> Info -> Info
mempty :: Info
$cmempty :: Info
Monoid, Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info] -> ShowS
$cshowList :: [Info] -> ShowS
show :: Info -> String
$cshow :: Info -> String
showsPrec :: Int -> Info -> ShowS
$cshowsPrec :: Int -> Info -> ShowS
Show)

data InfoEntry where
	InfoEntry :: (IsInfo v, Typeable v) => v -> InfoEntry

instance Show InfoEntry where
	show :: InfoEntry -> String
show (InfoEntry v
v) = forall a. Show a => a -> String
show v
v

-- Extracts the value from an InfoEntry but only when
-- it's of the requested type.
extractInfoEntry :: Typeable v => InfoEntry -> Maybe v
extractInfoEntry :: forall v. Typeable v => InfoEntry -> Maybe v
extractInfoEntry (InfoEntry v
v) = forall a b. (Typeable a, Typeable b) => a -> Maybe b
T.cast v
v

-- | Values stored in Info must be members of this class.
--
-- This is used to avoid accidentially using other data types
-- as info, especially type aliases which coud easily lead to bugs.
-- We want a little bit of dynamic types here, but not too far..
class (Typeable v, Monoid v, Show v) => IsInfo v where
	-- | Should this info be propagated out of a container to its Host?
	propagateInfo :: v -> PropagateInfo

data PropagateInfo
	= PropagateInfo Bool
	| PropagatePrivData
	-- ^ Info about PrivData generally will be propigated even in cases
	-- where other Info is not, so it treated specially.

-- | Any value in the `IsInfo` type class can be added to an Info.
addInfo :: IsInfo v => Info -> v -> Info
addInfo :: forall v. IsInfo v => Info -> v -> Info
addInfo (Info [InfoEntry]
l) v
v = [InfoEntry] -> Info
Info ([InfoEntry]
lforall a. [a] -> [a] -> [a]
++[forall v. (IsInfo v, Typeable v) => v -> InfoEntry
InfoEntry v
v])

-- | Converts any value in the `IsInfo` type class into an Info,
-- which is otherwise empty.
toInfo :: IsInfo v => v -> Info
toInfo :: forall v. IsInfo v => v -> Info
toInfo = forall v. IsInfo v => Info -> v -> Info
addInfo forall a. Monoid a => a
mempty

-- | Extracts a value from an Info.
fromInfo :: IsInfo v => Info -> v
fromInfo :: forall v. IsInfo v => Info -> v
fromInfo (Info [InfoEntry]
l) = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall v. Typeable v => InfoEntry -> Maybe v
extractInfoEntry [InfoEntry]
l)

-- | Maps a function over all values stored in the Info that are of the
-- appropriate type.
mapInfo :: IsInfo v => (v -> v) -> Info -> Info
mapInfo :: forall v. IsInfo v => (v -> v) -> Info -> Info
mapInfo v -> v
f (Info [InfoEntry]
l) = [InfoEntry] -> Info
Info (forall a b. (a -> b) -> [a] -> [b]
map InfoEntry -> InfoEntry
go [InfoEntry]
l)
  where
	go :: InfoEntry -> InfoEntry
go InfoEntry
i = case forall v. Typeable v => InfoEntry -> Maybe v
extractInfoEntry InfoEntry
i of
		Maybe v
Nothing -> InfoEntry
i
		Just v
v -> forall v. (IsInfo v, Typeable v) => v -> InfoEntry
InfoEntry (v -> v
f v
v)

-- | Use this to put a value in Info that is not a monoid.
-- The last value set will be used. This info does not propagate
-- out of a container.
data InfoVal v = NoInfoVal | InfoVal v
	deriving (Typeable, Int -> InfoVal v -> ShowS
forall v. Show v => Int -> InfoVal v -> ShowS
forall v. Show v => [InfoVal v] -> ShowS
forall v. Show v => InfoVal v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InfoVal v] -> ShowS
$cshowList :: forall v. Show v => [InfoVal v] -> ShowS
show :: InfoVal v -> String
$cshow :: forall v. Show v => InfoVal v -> String
showsPrec :: Int -> InfoVal v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> InfoVal v -> ShowS
Show)

instance Sem.Semigroup (InfoVal v) where
	InfoVal v
_ <> :: InfoVal v -> InfoVal v -> InfoVal v
<> v :: InfoVal v
v@(InfoVal v
_) = InfoVal v
v
	InfoVal v
v <> InfoVal v
NoInfoVal = InfoVal v
v

instance Monoid (InfoVal v) where
	mempty :: InfoVal v
mempty = forall v. InfoVal v
NoInfoVal
	mappend :: InfoVal v -> InfoVal v -> InfoVal v
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)

instance (Typeable v, Show v) => IsInfo (InfoVal v) where
	propagateInfo :: InfoVal v -> PropagateInfo
propagateInfo InfoVal v
_ = Bool -> PropagateInfo
PropagateInfo Bool
False

fromInfoVal :: InfoVal v -> Maybe v
fromInfoVal :: forall v. InfoVal v -> Maybe v
fromInfoVal InfoVal v
NoInfoVal = forall a. Maybe a
Nothing
fromInfoVal (InfoVal v
v) = forall a. a -> Maybe a
Just v
v