[Haskell-cafe] ANNOUNCE IDynamic-0.1
Alberto G. Corona
agocorona at gmail.com
Fri Oct 16 18:16:17 EDT 2009
IDynamic is variant of Data.Dynamic that can be indexed, serialized.,
stored, transmitted trough communications etc. So it can be used in abstract
data containers, persistence, communications etc.
http://hackage.haskell.org/package/IDynamic
I Just uploaded it, so the documentation has not been created by Hackage.
However I uincluded an example in the pachage.
{-# OPTIONS -XTypeSynonymInstances #-}
module Main where
import Data.IResource
import Data.IDynamic
import Data.Typeable
instance IResource Int where
keyResource x= "I"
serialize = show
deserialize = read
defPath _= "saved/"
instance IResource String where
keyResource x= take 5 x
serialize = show
deserialize = read
defPath _= "saved/"
main= do
putStrLn "see the code to know the meaning of he results"
registerType :: IO Int -- register both datatypes
(Int, and String)
registerType :: IO String
let x= 1 :: Int
let list= [IDynamic x, IDynamic "hello, how are you"]
--typical Dynamic usage
let assoc= zip (map keyResource list) list
print $ lookup (keyResource (5 ::Int)) assoc -- lookup a
IDynamic object from a container and show it
mapM writeResource list
mds ← readResource $ IDynamic "hello" -- save both
objects
case mds of
Nothing → error "must have been Just!" --why?
Just ds → do
putStrLn $ serialize ds
-- serialize the dynamic object and print it
let str= fromIDyn ds :: String --
casting
putStrLn str
-- print the string read
let y= fromIDyn ds :: Int -- casting
error
print y
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20091016/8715943e/attachment.html
More information about the Haskell-Cafe
mailing list