{-# 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
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
extractInfoEntry :: Typeable v => InfoEntry -> Maybe v
(InfoEntry v
v) = forall a b. (Typeable a, Typeable b) => a -> Maybe b
T.cast v
v
class (Typeable v, Monoid v, Show v) => IsInfo v where
propagateInfo :: v -> PropagateInfo
data PropagateInfo
= PropagateInfo Bool
| PropagatePrivData
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])
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
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)
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)
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