happstack-data 0.2.1 → 0.3.1

raw patch · 5 files changed

+44/−5 lines, 5 filesdep ~happstack-util

Dependency ranges changed: happstack-util

Files

happstack-data.cabal +8/−3
src/Happstack/Data/DeriveAll.hs +1/−1
src/Happstack/Data/GOps.hs +19/−0
src/Happstack/Data/Serialize.hs +11/−0
src/Happstack/Data/SerializeTH.hs +5/−1

happstack-data.cabal view

@@ -1,5 +1,5 @@ Name:               happstack-data-Version:            0.2.1+Version:            0.3.1 License:            BSD3 License-File:       COPYING Author:             Happstack team, HAppS LLC@@ -22,8 +22,13 @@      * Marshalling Haskell values to and from HTML forms. Tested-With:        GHC==6.6.1, GHC==6.8.2 Build-Type:         Simple-Cabal-Version:      >= 1.2.3+Cabal-Version:      >= 1.6 +source-repository head+    type:     darcs+    subdir:   happstack-data+    location: http://patch-tag.com/publicrepos/happstack+ flag base4  Flag tests@@ -39,7 +44,7 @@   Build-Depends:      binary,                       bytestring,                       containers,-                      happstack-util >= 0.2.1 && < 0.3, +                      happstack-util >= 0.3.1 && < 0.4,                        HaXml >= 1.13 && < 1.14,                       mtl,                       pretty,

src/Happstack/Data/DeriveAll.hs view

@@ -54,7 +54,7 @@  -- | The 'deriveAll' function takes a list of classes to derive and -- a block of declarations. It will additionally derive instances for--- 'Typeable', 'Old.Data' and 'New.Data'.+-- Typeable, Old.Data and New.Data. -- -- Example: --

src/Happstack/Data/GOps.hs view

@@ -6,28 +6,47 @@  -- useful generic functions with better names +-- | @gSet x y@ will traveral @x@ and replace +-- any instances of the type @a@ in its structure +-- with @y@. gSet :: (Data b, Typeable a) => a -> b -> b gSet = gReplace . const +-- | @gReplace f b@ will traverse @x@ and will act on+-- any instance of the type @a@ in its structure with+-- the function @f@. gReplace :: (Typeable a, Data b) => (a -> a) -> b -> b gReplace f x = everywhere (mkT f) x +-- | @gFind a@ will extract any elements of type @b@ from+-- @a@'s structure in accordance with the MonadPlus+-- instance, e.g. Maybe Foo will return the first Foo+-- found while [Foo] will return the list of Foos found. gFind :: (MonadPlus m, Data a, Typeable b) => a -> m b gFind = msum . map return . listify (const True) +-- | Acts as gFind but will throw an exception if+-- nothing is found. gFind' :: (Data a, Typeable b) => a -> b gFind' = fromJust . gFind --Monad versions +-- | A generalized modify that will apply the modification+-- function to the structure of the state. gModify :: (MonadState s m,Typeable a,Data s) => (a->a) -> m () gModify = modify . gReplace +-- | A generalized ask that will traverse the+-- stored type of the MonadReader in an attempt to find+-- an @a@ and will then apply the provided function if+-- found. gAsk :: (Data r, Typeable a, MonadReader r m, MonadPlus n) =>         (a -> n b) -> m (n b) gAsk f = do st <- ask             let y = gFind st              return $ maybe mzero f y +-- | The equivalent of 'gAsk' for MonadState gGet :: (Data s, Typeable a, MonadState s m, MonadPlus n) =>         (a -> n b) -> c -> m (n b) gGet f _ = do st <- get

src/Happstack/Data/Serialize.hs view

@@ -41,6 +41,10 @@ mkPrevious :: forall a b. (Serialize b, Migrate b a) => Proxy b -> Previous a mkPrevious Proxy = Previous (Proxy :: Proxy b) +-- | Creates a Mode that is a new version of the type carried by the provided proxy+-- and with the provided version number.  Note that since VersionId is an instance of+-- Num that you may use int literals when calling extension, e.g. +-- @extension 1 (Proxy :: Proxy OldState)@ extension :: forall a b. (Serialize b, Migrate b a) => VersionId a -> Proxy b -> Mode a extension vs prox = Versioned vs (Just (mkPrevious prox)) @@ -53,6 +57,11 @@ data Mode a = Primitive -- ^ Data layout won't change. Used for types like Int and Char.             | Versioned (VersionId a) (Maybe (Previous a)) +-- | The Version type class is used to describe whether a type is fundamental+-- or if it is meant to extend another type.  For a user defined type that+-- does not extend any others, one can use the default instance of Version, e.g.+-- @instance Version MyType@ to define it has having a version id of 0 and previous+-- type. class Version a where     mode :: Mode a     mode = Versioned 0 Nothing@@ -274,6 +283,8 @@ mkObject obj = Object { objectType = show (typeOf obj)                       , objectData = serialize obj } +-- | Uniform container for any serialized data.  It contains a string rep of the type+-- and the actual data serialized to a byte string. data Object = Object { objectType :: String                      , objectData :: L.ByteString                      }  deriving (Typeable,Show)

src/Happstack/Data/SerializeTH.hs view

@@ -12,6 +12,10 @@  data Class = Tagged [(Name, Int)] Cxt [Name] +-- | Derives an instance of Serialize for the provided type+-- Should work in most cases if the type is already and instance+-- of Version.  +-- Ex: @$(deriveSerialize ''Foo) deriveSerialize :: Name -> Q [Dec] deriveSerialize name     = do c <- parseInfo name@@ -50,7 +54,7 @@                                 [ noBindS [| return $(foldl appE (conE conName) (map varE args)) |] ]                 in funD 'getCopy [clause [] (normalB getCopyBody) []] -+-- | Derives Serialize for a list of types deriveSerializeFor :: [Name] -> Q [Dec] deriveSerializeFor = liftM concat . mapM deriveSerialize