| Copyright | (c) Yu Li 2015 |
|---|---|
| License | BSD |
| Maintainer | ylilarry@gmail.com |
| Stability | experimental |
| Portability | GHC extensions |
| Safe Haskell | Safe |
| Language | Haskell2010 |
Data.Extend
Description
This package allows you to extend a Haskell data like how you do in OOP.
Here is an example use for testing:
data Test = Test | TestA {
f1 :: Int,
f2 :: Maybe Int,
f3 :: Maybe Int
} deriving (Show, Generic, Eq)
test1A = TestA 1 (Just 1) (Just 3)
test2A = TestA 0 Nothing (Just 2)
main :: IO ()
main = hspec $
describe "Data.Extend" $ do
specify "Int" $
(2 `extend` 1) `shouldBe` (2 :: Int)
specify "String" $
("b" `extend` "a") `shouldBe` "b"
specify "data 0" $
(Test `extend` Test) `shouldBe` Test
specify "data 1" $
(test2A `extend` test1A) `shouldBe` TestA 0 (Just 1) (Just 2)
Documentation
Methods
extend :: a -> a -> a Source #
By default
a `extend` b = a
Nothing `extend` Just a = Just a
To use the Extend class, simply make your data derive Generic.
If "a" is a user defined data type, then all Nothing fields of "a" are replaced by corresponding fields in "b",
ie, all Just fields in "a" will override corresponding fields in "b".
extend :: (Generic a, GExtend (Rep a)) => a -> a -> a Source #
By default
a `extend` b = a
Nothing `extend` Just a = Just a
To use the Extend class, simply make your data derive Generic.
If "a" is a user defined data type, then all Nothing fields of "a" are replaced by corresponding fields in "b",
ie, all Just fields in "a" will override corresponding fields in "b".