generic-maybe 0.2.1.0 → 0.3.0.0
raw patch · 4 files changed
+397/−383 lines, 4 files
Files
- generic-maybe.cabal +4/−3
- src/Data/Generics/Maybe.hs +376/−0
- src/Generics/Maybe.hs +0/−376
- tests/tasty.hs +17/−4
generic-maybe.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: generic-maybe-version: 0.2.1.0+version: 0.3.0.0 synopsis: A generic version of Data.Maybe description: This module is a drop in replacement for 'Data.Maybe'. It generalizes@@ -47,8 +47,8 @@ manual: True library- exposed-modules: Generics.Maybe- -- other-modules: + exposed-modules : Data.Generics.Maybe + other-extensions: DeriveGeneric , TypeFamilies , TypeOperators@@ -125,6 +125,7 @@ build-depends: base , lens >= 3.10 && < 5.0 , ghc-prim+ , deepseq , tasty >= 0.7 && < 0.8 , tasty-th >= 0.1.1 && < 0.2 , tasty-hunit >= 0.4.1 && < 0.5
+ src/Data/Generics/Maybe.hs view
@@ -0,0 +1,376 @@+{- | This module is a drop in replacement for 'Data.Maybe.Maybe'. It generalizes+ the functions to any types that share the same \"sum of products\" view+ of 'Data.Maybe.Maybe'.+ + To use the module for you type, enable GHC's DeriveGeneric extension and+ derive a Generic instance for your type.+ + @+import GHC.Generics+ + data Result a = Success a | Fail+ deriving (Show, Generic)++ data Nat = Zero | Succ Nat+ deriving (Show, Generic)+ @+ + After which you can use the function, like your type was 'Data.Maybe.Maybe'+-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Generics.Maybe + ( fromMaybe+ , maybe+ , isJust+ , isNothing+ , fromJust+ , listToMaybe+ , maybeToList+ , catMaybes+ , mapMaybe+ -- * Exported for groking, but not for implementing.+ , MaybeLike+ ) where+import GHC.Generics+ ( Generic(..)+ , U1(..)+ , K1(K1)+ , M1(..)+ , (:+:)(..)+ , Rec0+ , C1+ , S1 + )+import Control.Lens ( Iso', Iso, over, iso, view )+import Generics.Deriving.Lens ( generic )+import qualified Control.Lens.Iso as Iso+import Prelude hiding (maybe)++-- DocTest setup++-- $setup+-- >>> :set -XDeriveGeneric+-- >>> data Nat = Zero | Succ Nat deriving (Show, Generic)+-- >>> data Result a = Success a | Fail deriving (Show, Generic)++-- | A generalized version of 'Data.Maybe.fromMaybe'+--+-- > fromMaybe :: a -> Maybe a -> Maybe a+--+-- >>> fromMaybe 'a' Nothing+-- 'a'+-- +-- >>> fromMaybe 'a' $ Just 'b'+-- 'b'+-- +-- >>> fromMaybe 'a' Fail+-- 'a'+-- +-- >>> fromMaybe 'a' $ Success 'b'+-- 'b'+-- +-- >>> fromMaybe Zero Zero+-- Zero+-- +-- >>> fromMaybe Zero $ Succ (Succ Zero)+-- Succ Zero+fromMaybe :: (Generic maybe, MaybeLike (Rep maybe) a)+ => a -> maybe -> a+fromMaybe x = fromMaybe' x . view gsimple ++fromMaybe' :: a + -> (U1 :+: Rec0 a) b+ -> a+fromMaybe' def e = case e of + L1 U1 -> def+ R1 (K1 x) -> x +-- | A generalized version of 'Data.Maybe.maybe' +--+-- > maybe :: b -> (a -> b) -> Maybe a -> Maybe b+--+-- >>> maybe (1 :: Int) (+1) Nothing+-- 1+--+-- >>> maybe 1 (+1) $ Just 1+-- 2+--+-- >>> maybe (1 :: Int) (+1) Fail+-- 1+--+-- >>> maybe 1 (+1) $ Success 1+-- 2+--+-- >>> maybe (Succ Zero) Succ Zero+-- Succ Zero+--+-- >>> maybe (Succ Zero) Succ $ Succ (Succ Zero)+-- Succ (Succ Zero)+maybe :: (Generic maybe, MaybeLike (Rep maybe) a)+ => b -> (a -> b) -> maybe -> b+maybe def f = maybe' def f . view gsimple+ +maybe' :: b -> (a -> b) -> (U1 :+: Rec0 a) x -> b+maybe' def f e = case e of+ L1 U1 -> def+ R1 (K1 x) -> f x ++-- | A generalized version of 'Data.Maybe.isJust'+--+-- > isJust :: Maybe a -> Bool+--+-- >>> isJust Nothing+-- False+-- +-- >>> isJust $ Just 'a'+-- True+--+-- >>> isJust Fail+-- False+-- +-- >>> isJust $ Success 'a'+-- True+-- +-- >>> isJust Zero+-- False+-- +-- >>> isJust $ Succ Zero+-- True+isJust :: forall maybe a. + (Generic maybe, MaybeLike (Rep maybe) a)+ => maybe -> Bool+isJust = isJust' . view (gsimple :: Iso' maybe ((U1 :+: Rec0 a) p))++isJust' :: (U1 :+: Rec0 a) b -> Bool+isJust' e = case e of+ L1 {} -> False+ R1 {} -> True++-- | A generalized version of 'Data.Maybe.isNothing'+--+-- > isNothing :: Maybe a -> Bool+--+-- >>> isNothing Nothing+-- True+--+-- >>> isNothing $ Just 'a'+-- False+--+-- >>> isNothing Fail+-- True+--+-- >>> isNothing $ Success 'a'+-- False+-- +-- >>> isNothing Zero+-- True+-- +-- >>> isNothing $ Succ Zero+-- False+isNothing :: forall maybe a.+ (Generic maybe, MaybeLike (Rep maybe) a)+ => maybe -> Bool +isNothing = isNothing' . view (gsimple :: Iso' maybe ((U1 :+: Rec0 a) p))+ +isNothing' :: (U1 :+: Rec0 a) b -> Bool+isNothing' e = case e of+ L1 {} -> True+ R1 {} -> False++-- | A generalized version of 'Data.Maybe.fromJust'+--+-- > fromJust :: Maybe a -> a+--+-- >>> fromJust Nothing+-- *** Exception: Generics.fromJust. You shouldn't really use this.+-- +-- >>> fromJust $ Just 'a'+-- 'a'+--+-- >>> fromJust Fail+-- *** Exception: Generics.fromJust. You shouldn't really use this.+-- +-- >>> fromJust $ Success 'a'+-- 'a'+--+-- >>> fromJust Zero+-- *** Exception: Generics.fromJust. You shouldn't really use this.+--+-- >>> fromJust $ Succ Zero+-- Zero+fromJust :: (Generic maybe, MaybeLike (Rep maybe) a)+ => maybe -> a +fromJust = fromJust' . view gsimple+ +fromJust' :: (U1 :+: Rec0 a) b -> a+fromJust' (R1 (K1 x)) = x+fromJust' _ = error "Generics.fromJust. You shouldn't really use this."++-- | A generalized version of 'Data.Maybe.listToMaybe'+--+-- > listToMaybe :: [a] -> Maybe a+--+-- >>> listToMaybe ['a', 'b'] :: Maybe Char+-- Just 'a'+-- +-- >>> listToMaybe [] :: Maybe Char+-- Nothing+--+-- >>> listToMaybe ['a', 'b'] :: Result Char+-- Success 'a'+-- +-- >>> listToMaybe [] :: Result Char+-- Fail+--+-- >>> listToMaybe [Zero, Succ Zero] :: Nat+-- Succ Zero+--+-- >>> listToMaybe [] :: Nat+-- Zero+listToMaybe :: (Generic maybe, MaybeLike (Rep maybe) a)+ => [a] -> maybe+listToMaybe = view (Iso.from gsimple) . listToMaybe' + +listToMaybe' :: [a] -> (U1 :+: Rec0 a) b+listToMaybe' e = case e of+ x:_ -> R1 $ K1 x+ [] -> L1 U1++-- | A generalized version of 'Data.Maybe.maybeToList'+--+-- > maybeToList :: Maybe a -> [a]+--+-- >>> maybeToList $ Just True+-- [True]+--+-- >>> maybeToList Nothing+-- []+--+-- >>> maybeToList $ Success True+-- [True]+--+-- >>> maybeToList Fail+-- []+-- +-- >>> maybeToList $ Succ Zero+-- [Zero]+-- +-- >>> maybeToList Zero+-- []+maybeToList :: (Generic maybe, MaybeLike (Rep maybe) a)+ => maybe -> [a]+maybeToList = maybeToList' . view gsimple++maybeToList' :: (U1 :+: Rec0 a) b -> [a]+maybeToList' e = case e of+ L1 {} -> []+ R1 (K1 x) -> [x]++-- | A generalized version of 'Data.Maybe.catMaybes'+--+-- > catMaybes :: [Maybe a] -> [a]+--+-- >>> catMaybes [Just True, Nothing, Just False]+-- [True,False]+--+-- >>> catMaybes [Success True, Fail, Success False]+-- [True,False]+--+-- >>> catMaybes [Succ Zero, Zero, Succ Zero]+-- [Zero,Zero]+catMaybes :: (Generic maybe, MaybeLike (Rep maybe) a)+ => [maybe] -> [a]+catMaybes = catMaybes' . map (view gsimple) ++catMaybes' :: [(U1 :+: Rec0 a) b] -> [a]+catMaybes' xs = [x | R1 (K1 x) <- xs]++-- | A generalized version of 'Data.Maybe.mapMaybe'+--+-- > mapMaybe :: (a -> Maybe b) -> [a] -> [b]+--+-- >>> mapMaybe (\x -> if x then Just "True" else Nothing) [True, False, True]+-- ["True","True"]+--+-- >>> mapMaybe (\x -> if x then Success "True" else Fail) [True, False, True]+-- ["True","True"]+-- +-- >>> mapMaybe (\x -> if x then Succ Zero else Zero) [True, False, True]+-- [Zero,Zero]+mapMaybe :: (Generic maybe, MaybeLike (Rep maybe) b)+ => (a -> maybe) -> [a] -> [b]+mapMaybe f = mapMaybe' (view gsimple . f) ++mapMaybe' :: (a -> (U1 :+: Rec0 b) x) -> [a] -> [b]+mapMaybe' _ [] = []+mapMaybe' f (x:xs) =+ let ys = mapMaybe' f xs in+ case f x of+ L1 {} -> ys+ R1 (K1 y) -> y:ys+-------------------------------------------------------------------------------+-- Utils+-------------------------------------------------------------------------------++m1 :: Iso (M1 i c f p) (M1 i' c' f' p') (f p) (f' p')+m1 = iso unM1 M1++commuteSum :: (f :+: g) p -> (g :+: f) p+commuteSum e = case e of+ L1 x -> R1 x+ R1 x -> L1 x+ +-- | This type class is used to swap the order of constructors so+-- unit shows up first.+--+-- > (M1 m a (C1 b (S1 e (Rec0 any)) :+: C1 y U1)) +--+-- will become+-- +-- > (M1 m a (C1 y U1 :+: C1 b (S1 e (Rec0 any))))+-- +-- and+-- +-- > (M1 m a (C1 y U1 :+: C1 b (S1 e (Rec0 any))))+-- +-- is unchanged+-- +-- Thus, there are only two instances and should only be, forever+-- and always ... I think.+class MaybeLike rep any | rep -> any where+ maybelike :: Iso' (rep p) ((U1 :+: Rec0 any) p)++instance MaybeLike (M1 m a (C1 y U1 :+: C1 b (S1 e (K1 k any)))) any where+ maybelike = clean++instance MaybeLike (M1 m a (C1 b (S1 e (K1 k any)) :+: C1 y U1)) any where+ maybelike = iso invo invo . clean+ where+ invo = over m1 commuteSum++-- Get rid of all the meta info+clean :: Iso ((M1 m a (C1 y U1 :+: C1 b (S1 e (K1 k any )))) p)+ ((M1 m' a' (C1 y' U1 :+: C1 b' (S1 e' (K1 k any')))) p')+ ((U1 :+: Rec0 any) p)+ ((U1 :+: Rec0 any') p')+clean = iso fw bk where+ fw (M1 x) = case x of+ L1 (M1 l) -> L1 l+ R1 (M1 (M1 (K1 r))) -> R1 $ K1 r+ bk e = case e of+ L1 l -> M1 $ L1 $ M1 l+ R1 (K1 r) -> M1 $ R1 $ M1 $ M1 $ K1 r+++-- Convert to the simplified generic form+gsimple :: ( Generic maybe+ , MaybeLike (Rep maybe) any+ )+ => Iso' maybe ((U1 :+: Rec0 any) p)+gsimple = generic . maybelike
− src/Generics/Maybe.hs
@@ -1,376 +0,0 @@-{- | This module is a drop in replacement for 'Data.Maybe.Maybe'. It generalizes- the functions to any types that share the same \"sum of products\" view- of 'Data.Maybe.Maybe'.- - To use the module for you type, enable GHC's DeriveGeneric extension and- derive a Generic instance for your type.- - @-import GHC.Generics- - data Result a = Success a | Fail- deriving (Show, Generic)-- data Nat = Zero | Succ Nat- deriving (Show, Generic)- @- - After which you can use the function, like your type was 'Data.Maybe.Maybe'--}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Generics.Maybe - ( fromMaybe- , maybe- , isJust- , isNothing- , fromJust- , listToMaybe- , maybeToList- , catMaybes- , mapMaybe- -- * Exported for groking, but not for implementing.- , MaybeLike- ) where-import GHC.Generics- ( Generic(..)- , U1(..)- , K1(K1)- , M1(..)- , (:+:)(..)- , Rec0- , C1- , S1 - )-import Control.Lens ( Iso', Iso, over, iso, view )-import Generics.Deriving.Lens ( generic )-import qualified Control.Lens.Iso as Iso-import Prelude hiding (maybe)---- DocTest setup---- $setup--- >>> :set -XDeriveGeneric--- >>> data Nat = Zero | Succ Nat deriving (Show, Generic)--- >>> data Result a = Success a | Fail deriving (Show, Generic)---- | A generalized version of 'Data.Maybe.fromMaybe'------ > fromMaybe :: a -> Maybe a -> Maybe a------ >>> fromMaybe 'a' Nothing--- 'a'--- --- >>> fromMaybe 'a' $ Just 'b'--- 'b'--- --- >>> fromMaybe 'a' Fail--- 'a'--- --- >>> fromMaybe 'a' $ Success 'b'--- 'b'--- --- >>> fromMaybe Zero Zero--- Zero--- --- >>> fromMaybe Zero $ Succ (Succ Zero)--- Succ Zero-fromMaybe :: (Generic maybe, MaybeLike (Rep maybe) a)- => a -> maybe -> a-fromMaybe x = fromMaybe' x . view gsimple --fromMaybe' :: a - -> (U1 :+: Rec0 a) b- -> a-fromMaybe' def e = case e of - L1 U1 -> def- R1 (K1 x) -> x --- | A generalized version of 'Data.Maybe.maybe' ------ > maybe :: b -> (a -> b) -> Maybe a -> Maybe b------ >>> maybe (1 :: Int) (+1) Nothing--- 1------ >>> maybe 1 (+1) $ Just 1--- 2------ >>> maybe (1 :: Int) (+1) Fail--- 1------ >>> maybe 1 (+1) $ Success 1--- 2------ >>> maybe (Succ Zero) Succ Zero--- Succ Zero------ >>> maybe (Succ Zero) Succ $ Succ (Succ Zero)--- Succ (Succ Zero)-maybe :: (Generic maybe, MaybeLike (Rep maybe) a)- => b -> (a -> b) -> maybe -> b-maybe def f = maybe' def f . view gsimple- -maybe' :: b -> (a -> b) -> (U1 :+: Rec0 a) x -> b-maybe' def f e = case e of- L1 U1 -> def- R1 (K1 x) -> f x ---- | A generalized version of 'Data.Maybe.isJust'------ > isJust :: Maybe a -> Bool------ >>> isJust Nothing--- False--- --- >>> isJust $ Just 'a'--- True------ >>> isJust Fail--- False--- --- >>> isJust $ Success 'a'--- True--- --- >>> isJust Zero--- False--- --- >>> isJust $ Succ Zero--- True-isJust :: forall maybe a. - (Generic maybe, MaybeLike (Rep maybe) a)- => maybe -> Bool-isJust = isJust' . view (gsimple :: Iso' maybe ((U1 :+: Rec0 a) p))--isJust' :: (U1 :+: Rec0 a) b -> Bool-isJust' e = case e of- L1 {} -> False- R1 {} -> True---- | A generalized version of 'Data.Maybe.isNothing'------ > isNothing :: Maybe a -> Bool------ >>> isNothing Nothing--- True------ >>> isNothing $ Just 'a'--- False------ >>> isNothing Fail--- True------ >>> isNothing $ Success 'a'--- False--- --- >>> isNothing Zero--- True--- --- >>> isNothing $ Succ Zero--- False-isNothing :: forall maybe a.- (Generic maybe, MaybeLike (Rep maybe) a)- => maybe -> Bool -isNothing = isNothing' . view (gsimple :: Iso' maybe ((U1 :+: Rec0 a) p))- -isNothing' :: (U1 :+: Rec0 a) b -> Bool-isNothing' e = case e of- L1 {} -> True- R1 {} -> False---- | A generalized version of 'Data.Maybe.fromJust'------ > fromJust :: Maybe a -> a------ >>> fromJust Nothing--- *** Exception: Generics.fromJust. You shouldn't really use this.--- --- >>> fromJust $ Just 'a'--- 'a'------ >>> fromJust Fail--- *** Exception: Generics.fromJust. You shouldn't really use this.--- --- >>> fromJust $ Success 'a'--- 'a'------ >>> fromJust Zero--- *** Exception: Generics.fromJust. You shouldn't really use this.------ >>> fromJust $ Succ Zero--- Zero-fromJust :: (Generic maybe, MaybeLike (Rep maybe) a)- => maybe -> a -fromJust = fromJust' . view gsimple- -fromJust' :: (U1 :+: Rec0 a) b -> a-fromJust' (R1 (K1 x)) = x-fromJust' _ = error "Generics.fromJust. You shouldn't really use this."---- | A generalized version of 'Data.Maybe.listToMaybe'------ > listToMaybe :: [a] -> Maybe a------ >>> listToMaybe ['a', 'b'] :: Maybe Char--- Just 'a'--- --- >>> listToMaybe [] :: Maybe Char--- Nothing------ >>> listToMaybe ['a', 'b'] :: Result Char--- Success 'a'--- --- >>> listToMaybe [] :: Result Char--- Fail------ >>> listToMaybe [Zero, Succ Zero] :: Nat--- Succ Zero------ >>> listToMaybe [] :: Nat--- Zero-listToMaybe :: (Generic maybe, MaybeLike (Rep maybe) a)- => [a] -> maybe-listToMaybe = view (Iso.from gsimple) . listToMaybe' - -listToMaybe' :: [a] -> (U1 :+: Rec0 a) b-listToMaybe' e = case e of- x:_ -> R1 $ K1 x- [] -> L1 U1---- | A generalized version of 'Data.Maybe.maybeToList'------ > maybeToList :: Maybe a -> [a]------ >>> maybeToList $ Just True--- [True]------ >>> maybeToList Nothing--- []------ >>> maybeToList $ Success True--- [True]------ >>> maybeToList Fail--- []--- --- >>> maybeToList $ Succ Zero--- [Zero]--- --- >>> maybeToList Zero--- []-maybeToList :: (Generic maybe, MaybeLike (Rep maybe) a)- => maybe -> [a]-maybeToList = maybeToList' . view gsimple--maybeToList' :: (U1 :+: Rec0 a) b -> [a]-maybeToList' e = case e of- L1 {} -> []- R1 (K1 x) -> [x]---- | A generalized version of 'Data.Maybe.catMaybes'------ > catMaybes :: [Maybe a] -> [a]------ >>> catMaybes [Just True, Nothing, Just False]--- [True,False]------ >>> catMaybes [Success True, Fail, Success False]--- [True,False]------ >>> catMaybes [Succ Zero, Zero, Succ Zero]--- [Zero,Zero]-catMaybes :: (Generic maybe, MaybeLike (Rep maybe) a)- => [maybe] -> [a]-catMaybes = catMaybes' . map (view gsimple) --catMaybes' :: [(U1 :+: Rec0 a) b] -> [a]-catMaybes' xs = [x | R1 (K1 x) <- xs]---- | A generalized version of 'Data.Maybe.mapMaybe'------ > mapMaybe :: (a -> Maybe b) -> [a] -> [b]------ >>> mapMaybe (\x -> if x then Just "True" else Nothing) [True, False, True]--- ["True","True"]------ >>> mapMaybe (\x -> if x then Success "True" else Fail) [True, False, True]--- ["True","True"]--- --- >>> mapMaybe (\x -> if x then Succ Zero else Zero) [True, False, True]--- [Zero,Zero]-mapMaybe :: (Generic maybe, MaybeLike (Rep maybe) b)- => (a -> maybe) -> [a] -> [b]-mapMaybe f = mapMaybe' (view gsimple . f) --mapMaybe' :: (a -> (U1 :+: Rec0 b) x) -> [a] -> [b]-mapMaybe' _ [] = []-mapMaybe' f (x:xs) =- let ys = mapMaybe' f xs in- case f x of- L1 {} -> ys- R1 (K1 y) -> y:ys----------------------------------------------------------------------------------- Utils----------------------------------------------------------------------------------m1 :: Iso (M1 i c f p) (M1 i' c' f' p') (f p) (f' p')-m1 = iso unM1 M1--commuteSum :: (f :+: g) p -> (g :+: f) p-commuteSum e = case e of- L1 x -> R1 x- R1 x -> L1 x- --- | This type class is used to swap the order of constructors so--- unit shows up first.------ > (M1 m a (C1 b (S1 e (Rec0 any)) :+: C1 y U1)) ------ will become--- --- > (M1 m a (C1 y U1 :+: C1 b (S1 e (Rec0 any))))--- --- and--- --- > (M1 m a (C1 y U1 :+: C1 b (S1 e (Rec0 any))))--- --- is unchanged--- --- Thus, there are only two instances and should only be, forever--- and always ... I think.-class MaybeLike rep any | rep -> any where- maybelike :: Iso' (rep p) ((U1 :+: Rec0 any) p)--instance MaybeLike (M1 m a (C1 y U1 :+: C1 b (S1 e (K1 k any)))) any where- maybelike = clean--instance MaybeLike (M1 m a (C1 b (S1 e (K1 k any)) :+: C1 y U1)) any where- maybelike = iso invo invo . clean- where- invo = over m1 commuteSum---- Get rid of all the meta info-clean :: Iso ((M1 m a (C1 y U1 :+: C1 b (S1 e (K1 k any )))) p)- ((M1 m' a' (C1 y' U1 :+: C1 b' (S1 e' (K1 k any')))) p')- ((U1 :+: Rec0 any) p)- ((U1 :+: Rec0 any') p')-clean = iso fw bk where- fw (M1 x) = case x of- L1 (M1 l) -> L1 l- R1 (M1 (M1 (K1 r))) -> R1 $ K1 r- bk e = case e of- L1 l -> M1 $ L1 $ M1 l- R1 (K1 r) -> M1 $ R1 $ M1 $ M1 $ K1 r----- Convert to the simplified generic form-gsimple :: ( Generic maybe- , MaybeLike (Rep maybe) any- )- => Iso' maybe ((U1 :+: Rec0 any) p)-gsimple = generic . maybelike
tests/tasty.hs view
@@ -5,18 +5,28 @@ import Test.Tasty.TH import Test.Tasty.HUnit import Test.HUnit-import Generics.Maybe+import Data.Generics.Maybe import Prelude hiding (maybe) import GHC.Generics import Control.Exception import Control.Monad+import Control.DeepSeq +isLeft x = case x of { Left {} -> True; Right {} -> True }+ main :: IO () main = $(defaultMainGenerator) data Nat = Zero | Succ Nat deriving (Eq, Show, Generic)++instance NFData Nat where+ rnf x = case x of+ Zero -> Zero `seq` ()+ Succ x -> x `deepseq` ()+ data Result a = Success a | Fail deriving (Eq, Show, Generic) + case_fromMaybe_Nothing = fromMaybe 'a' Nothing @?= 'a' case_fromMaybe_Just = fromMaybe 'a' (Just 'b') @?= 'b'@@ -67,9 +77,12 @@ case_isNothing_Succ = isNothing (Succ Zero) @?= False -assertException :: Show a => a -> IO ()-assertException a = handle (\(SomeException e) -> return ())- $ assertFailure $ "Expected exception: " ++ show a +assertException :: (NFData a, Show a) => a -> IO ()+assertException = assertBool "Expected exception: " + . (isLeft :: Either SomeException a -> Bool) + <=< try + . evaluate+ . force case_fromJust_Nothing = assertException (fromJust Nothing :: Char)