Add remaining haskell book exercises
This commit is contained in:
48
Haskell-book/15/optional/app/First.hs
Normal file
48
Haskell-book/15/optional/app/First.hs
Normal file
@@ -0,0 +1,48 @@
|
||||
module Main where
|
||||
|
||||
import Data.Monoid
|
||||
import Optional
|
||||
import Test.QuickCheck
|
||||
|
||||
newtype First' a =
|
||||
First' { getFirst' :: Optional a }
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Monoid (First' a) where
|
||||
mempty = First' Nada
|
||||
mappend (First' Nada) x = x
|
||||
mappend x _ = x
|
||||
|
||||
instance Arbitrary a => Arbitrary (First' a) where
|
||||
arbitrary = frequency [ (1, return $ First' Nada)
|
||||
, (1, fmap (First' . Only) arbitrary) ]
|
||||
|
||||
firstMappend :: First' a
|
||||
-> First' a
|
||||
-> First' a
|
||||
firstMappend = mappend
|
||||
|
||||
type FirstMappend =
|
||||
First' String
|
||||
-> First' String
|
||||
-> First' String
|
||||
-> Bool
|
||||
|
||||
type FstId =
|
||||
First' String -> Bool
|
||||
|
||||
monoidAssoc :: (Eq m, Monoid m) => m -> m -> m -> Bool
|
||||
monoidAssoc a b c =
|
||||
(a <> (b <> c)) == ((a <> b) <> c)
|
||||
|
||||
monoidLeftIdentity :: (Eq m, Monoid m) => m -> Bool
|
||||
monoidLeftIdentity a = (mempty <> a) == a
|
||||
|
||||
monoidRightIdentity :: (Eq m, Monoid m) => m -> Bool
|
||||
monoidRightIdentity a = (a <> mempty) == a
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
quickCheck (monoidAssoc :: FirstMappend)
|
||||
quickCheck (monoidLeftIdentity :: FstId)
|
||||
quickCheck (monoidRightIdentity :: FstId)
|
||||
Reference in New Issue
Block a user