{-# 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 (b -> Info -> Info
NonEmpty Info -> Info
Info -> Info -> Info
(Info -> Info -> Info)
-> (NonEmpty Info -> Info)
-> (forall b. Integral b => b -> Info -> Info)
-> Semigroup 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 :: 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
Semigroup Info
-> Info
-> (Info -> Info -> Info)
-> ([Info] -> Info)
-> Monoid 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
$cp1Monoid :: Semigroup Info
Monoid, Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
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) = v -> String
forall a. Show a => a -> String
show v
v
extractInfoEntry :: Typeable v => InfoEntry -> Maybe v
(InfoEntry v
v) = v -> Maybe 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 :: Info -> v -> Info
addInfo (Info [InfoEntry]
l) v
v = [InfoEntry] -> Info
Info ([InfoEntry]
l[InfoEntry] -> [InfoEntry] -> [InfoEntry]
forall a. [a] -> [a] -> [a]
++[v -> InfoEntry
forall v. (IsInfo v, Typeable v) => v -> InfoEntry
InfoEntry v
v])
toInfo :: IsInfo v => v -> Info
toInfo :: v -> Info
toInfo = Info -> v -> Info
forall v. IsInfo v => Info -> v -> Info
addInfo Info
forall a. Monoid a => a
mempty
fromInfo :: IsInfo v => Info -> v
fromInfo :: Info -> v
fromInfo (Info [InfoEntry]
l) = [v] -> v
forall a. Monoid a => [a] -> a
mconcat ((InfoEntry -> Maybe v) -> [InfoEntry] -> [v]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe InfoEntry -> Maybe v
forall v. Typeable v => InfoEntry -> Maybe v
extractInfoEntry [InfoEntry]
l)
mapInfo :: IsInfo v => (v -> v) -> Info -> Info
mapInfo :: (v -> v) -> Info -> Info
mapInfo v -> v
f (Info [InfoEntry]
l) = [InfoEntry] -> Info
Info ((InfoEntry -> InfoEntry) -> [InfoEntry] -> [InfoEntry]
forall a b. (a -> b) -> [a] -> [b]
map InfoEntry -> InfoEntry
go [InfoEntry]
l)
where
go :: InfoEntry -> InfoEntry
go InfoEntry
i = case InfoEntry -> Maybe v
forall v. Typeable v => InfoEntry -> Maybe v
extractInfoEntry InfoEntry
i of
Maybe v
Nothing -> InfoEntry
i
Just v
v -> v -> InfoEntry
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
[InfoVal v] -> ShowS
InfoVal v -> String
(Int -> InfoVal v -> ShowS)
-> (InfoVal v -> String)
-> ([InfoVal v] -> ShowS)
-> Show (InfoVal v)
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 = InfoVal v
forall v. InfoVal v
NoInfoVal
mappend :: InfoVal v -> InfoVal v -> InfoVal v
mappend = InfoVal v -> InfoVal v -> InfoVal v
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 :: InfoVal v -> Maybe v
fromInfoVal InfoVal v
NoInfoVal = Maybe v
forall a. Maybe a
Nothing
fromInfoVal (InfoVal v
v) = v -> Maybe v
forall a. a -> Maybe a
Just v
v