summaryrefslogtreecommitdiff
path: root/src/Propellor/Types/Info.hs
diff options
context:
space:
mode:
authorJoey Hess2015-10-19 12:33:18 -0400
committerJoey Hess2015-10-19 12:33:18 -0400
commitace352cc0aa732d00900122e0ab8552c870f3901 (patch)
tree53e8a1019203a94131592f18e280859108129183 /src/Propellor/Types/Info.hs
parent10286791b63b198de7d0dc3742f8e1d58113d3f1 (diff)
improve Info type using GADT, at nomeata's suggestion
This makes Show Info work, and simplifies the implementation.
Diffstat (limited to 'src/Propellor/Types/Info.hs')
-rw-r--r--src/Propellor/Types/Info.hs40
1 files changed, 24 insertions, 16 deletions
diff --git a/src/Propellor/Types/Info.hs b/src/Propellor/Types/Info.hs
index e94c370e..59cc13e0 100644
--- a/src/Propellor/Types/Info.hs
+++ b/src/Propellor/Types/Info.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GADTs, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module Propellor.Types.Info (
Info,
@@ -6,7 +6,7 @@ module Propellor.Types.Info (
addInfo,
getInfo,
mapInfo,
- propigatableInfo,
+ propagatableInfo,
InfoVal(..),
fromInfoVal,
Typeable,
@@ -17,56 +17,64 @@ import Data.Monoid
import Data.Maybe
-- | Information about a Host, which can be provided by its properties.
-newtype Info = Info [(Dynamic, Bool)]
- deriving (Monoid)
+newtype Info = Info [InfoEntry]
+ deriving (Monoid, Show)
-instance Show Info where
- show (Info l) = "Info " ++ show (map (dynTypeRep . fst) l)
+data InfoEntry where
+ InfoEntry :: (IsInfo v, Typeable v) => v -> InfoEntry
+
+instance Show InfoEntry where
+ show (InfoEntry v) = show v
+
+-- Extracts the value from an InfoEntry but only when
+-- it's of the requested type.
+extractInfoEntry :: Typeable v => InfoEntry -> Maybe v
+extractInfoEntry (InfoEntry v) = fromDynamic (toDyn 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) => IsInfo v where
+class (Typeable v, Monoid v, Show v) => IsInfo v where
-- | Should info of this type be propagated out of a
-- container to its Host?
propagateInfo :: v -> Bool
-- | Any value in the `IsInfo` type class can be added to an Info.
addInfo :: IsInfo v => Info -> v -> Info
-addInfo (Info l) v = Info ((toDyn v, propagateInfo v):l)
+addInfo (Info l) v = Info (InfoEntry v:l)
-- The list is reversed here because addInfo builds it up in reverse order.
getInfo :: IsInfo v => Info -> v
-getInfo (Info l) = mconcat (mapMaybe (fromDynamic . fst) (reverse l))
+getInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse 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 f (Info l) = Info (map go l)
where
- go (i, p) = case fromDynamic i of
- Nothing -> (i, p)
- Just v -> (toDyn (f v), p)
+ go i = case extractInfoEntry i of
+ Nothing -> i
+ Just v -> InfoEntry (f v)
-- | Filters out parts of the Info that should not propagate out of a
-- container.
-propigatableInfo :: Info -> Info
-propigatableInfo (Info l) = Info (filter snd l)
+propagatableInfo :: Info -> Info
+propagatableInfo (Info l) = Info (filter (\(InfoEntry a) -> propagateInfo a) l)
-- | 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)
+ deriving (Typeable, Show)
instance Monoid (InfoVal v) where
mempty = NoInfoVal
mappend _ v@(InfoVal _) = v
mappend v NoInfoVal = v
-instance Typeable v => IsInfo (InfoVal v) where
+instance (Typeable v, Show v) => IsInfo (InfoVal v) where
propagateInfo _ = False
fromInfoVal :: InfoVal v -> Maybe v