2 files changed, 29 insertions(+), 2 deletions(-)

M Graphics/Text/Font/Choose/Pattern.hs
M Graphics/Text/Font/Choose/Value.hs

@@ 3,7 3,7 @@ module Graphics.Text.Font.Choose.Pattern (Pattern(..), Binding(..), equalSubset,
     normalizePattern, filter, defaultSubstitute, nameParse, nameUnparse, format,
     Pattern_, withPattern, thawPattern, thawPattern_, patternAsPointer,
 
-    setValue, setValues, unset,
+    setValue, setValues, unset, getValue, getValue0,
     parseFontFamily, parseFontFeatures, parseFontVars, parseLength,
     parseFontStretch, parseFontWeight) where
 


@@ 49,6 49,8 @@ setValues key b values pat = (key, [(b, toValue v) | v <- values]):unset key pat
 getValue :: String -> Pattern -> Value
 getValue key pat | Just ((_, ret):_) <- lookup key pat = ret
     | otherwise = ValueVoid
+getValue0 :: ToValue x => String -> Pattern -> x
+getValue0 key pat = fromValue' $ getValue key pat
 
 unset key mapping = [(key', val') | (key', val') <- mapping, key' /= key]
 

@@ 8,6 8,7 @@ import Graphics.Text.Font.Choose.CharSet (CharSet, withCharSet, thawCharSet)
 import FreeType.Core.Base (FT_Face(..))
 import Graphics.Text.Font.Choose.LangSet (LangSet, withLangSet, thawLangSet)
 import Graphics.Text.Font.Choose.Range (Range, withRange, thawRange)
+import Control.Exception (throw)
 
 import Foreign.Ptr (Ptr, castPtr)
 import Foreign.Storable (Storable(..))


@@ 17,7 18,7 @@ import Foreign.C.String (withCString, peekCString)
 
 import GHC.Generics (Generic)
 import Data.Hashable (Hashable)
-import Graphics.Text.Font.Choose.Result (throwNull)
+import Graphics.Text.Font.Choose.Result (throwNull, Error(ErrTypeMismatch))
 
 data Value = ValueVoid
     | ValueInt Int


@@ 34,27 35,51 @@ instance Hashable Value
 
 class ToValue x where
     toValue :: x -> Value
+    fromValue :: Value -> Maybe x
+    fromValue' :: Value -> x -- throws Result.Error
+    fromValue' self | Just ret <- fromValue self = ret
+    fromValue' _ = throw ErrTypeMismatch
 
 instance ToValue () where
     toValue () = ValueVoid
+    fromValue ValueVoid = Just ()
+    fromValue _ = Nothing
 instance ToValue Int where
     toValue = ValueInt
+    fromValue (ValueInt x) = Just x
+    fromValue _ = Nothing
 instance ToValue Double where
     toValue = ValueDouble
+    fromValue (ValueDouble x) = Just x
+    fromValue _ = Nothing
 instance ToValue String where
     toValue = ValueString
+    fromValue (ValueString x) = Just x
+    fromValue _ = Nothing
 instance ToValue Bool where
     toValue = ValueBool
+    fromValue (ValueBool x) = Just x
+    fromValue _ = Nothing
 instance ToValue (M22 Double) where
     toValue = ValueMatrix
+    fromValue (ValueMatrix x) = Just x
+    fromValue _ = Nothing
 instance ToValue CharSet where
     toValue = ValueCharSet
+    fromValue (ValueCharSet x) = Just x
+    fromValue _ = Nothing
 instance ToValue FT_Face where
     toValue = ValueFTFace
+    fromValue (ValueFTFace x) = Just x
+    fromValue _ = Nothing
 instance ToValue LangSet where
     toValue = ValueLangSet
+    fromValue (ValueLangSet x) = Just x
+    fromValue _ = Nothing
 instance ToValue Range where
     toValue = ValueRange
+    fromValue (ValueRange x) = Just x
+    fromValue _ = Nothing
 
 ------
 --- Low-level