generic-maybe 0.2.0.0 → 0.2.1.0
raw patch · 3 files changed
+203/−44 lines, 3 filesdep +HUnitdep +ghc-primdep +tastydep ~base
Dependencies added: HUnit, ghc-prim, tasty, tasty-hunit, tasty-th
Dependency ranges changed: base
Files
- generic-maybe.cabal +28/−8
- src/Generics/Maybe.hs +44/−36
- tests/tasty.hs +131/−0
generic-maybe.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: generic-maybe-version: 0.2.0.0+version: 0.2.1.0 synopsis: A generic version of Data.Maybe description: This module is a drop in replacement for 'Data.Maybe'. It generalizes@@ -39,12 +39,12 @@ flag test-doctests default: True manual: True- + -- You can disable the hlint test suite with -f-test-hlint -- Disabled until the LambdaCase extension is added src-exts flag test-hlint- default: False- manual: False+ default: True+ manual: True library exposed-modules: Generics.Maybe@@ -55,11 +55,13 @@ , MultiParamTypeClasses , FunctionalDependencies , FlexibleContexts- , LambdaCase , FlexibleInstances- , ConstraintKinds- build-depends: base >=4.6 && <4.7+ , ScopedTypeVariables+ + build-depends: base >=4.5 && < 4.7 , lens >=3.10 && < 5.0+ , ghc-prim+ hs-source-dirs: src default-language: Haskell2010 @@ -72,6 +74,9 @@ hs-source-dirs: tests default-language: Haskell2010 + if impl(ghc<7.6.1)+ buildable: False+ if !flag(test-doctests) buildable: False else@@ -100,7 +105,7 @@ test-suite hlint type: exitcode-stdio-1.0 main-is: hlint.hs- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N+-- ghc-options: -w -threaded -rtsopts -with-rtsopts=-N hs-source-dirs: tests default-language: Haskell2010 @@ -110,3 +115,18 @@ build-depends: base, hlint >= 1.7+ +test-suite tasty+ type: exitcode-stdio-1.0+ main-is: tasty.hs+ hs-source-dirs: tests, src+ default-language: Haskell2010+ + build-depends: base+ , lens >= 3.10 && < 5.0+ , ghc-prim+ , tasty >= 0.7 && < 0.8+ , tasty-th >= 0.1.1 && < 0.2+ , tasty-hunit >= 0.4.1 && < 0.5+ , HUnit >= 1.2 && < 1.3+
src/Generics/Maybe.hs view
@@ -17,9 +17,7 @@ After which you can use the function, like your type was 'Data.Maybe.Maybe' -}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeSynonymInstances #-}@@ -39,17 +37,17 @@ , mapMaybe -- * Exported for groking, but not for implementing. , MaybeLike- , G ) where import GHC.Generics- ( Generic(..),- U1(..),- K1(K1),- M1(..),- type (:+:)(..),- Rec0,- C1,- S1 )+ ( 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@@ -90,7 +88,7 @@ fromMaybe' :: a -> (U1 :+: Rec0 a) b -> a-fromMaybe' def = \case +fromMaybe' def e = case e of L1 U1 -> def R1 (K1 x) -> x -- | A generalized version of 'Data.Maybe.maybe' @@ -119,7 +117,7 @@ maybe def f = maybe' def f . view gsimple maybe' :: b -> (a -> b) -> (U1 :+: Rec0 a) x -> b-maybe' def f = \case+maybe' def f e = case e of L1 U1 -> def R1 (K1 x) -> f x @@ -150,7 +148,7 @@ isJust = isJust' . view (gsimple :: Iso' maybe ((U1 :+: Rec0 a) p)) isJust' :: (U1 :+: Rec0 a) b -> Bool-isJust' = \case+isJust' e = case e of L1 {} -> False R1 {} -> True @@ -181,7 +179,7 @@ isNothing = isNothing' . view (gsimple :: Iso' maybe ((U1 :+: Rec0 a) p)) isNothing' :: (U1 :+: Rec0 a) b -> Bool-isNothing' = \case+isNothing' e = case e of L1 {} -> True R1 {} -> False @@ -240,7 +238,7 @@ listToMaybe = view (Iso.from gsimple) . listToMaybe' listToMaybe' :: [a] -> (U1 :+: Rec0 a) b-listToMaybe' = \case+listToMaybe' e = case e of x:_ -> R1 $ K1 x [] -> L1 U1 @@ -270,7 +268,7 @@ maybeToList = maybeToList' . view gsimple maybeToList' :: (U1 :+: Rec0 a) b -> [a]-maybeToList' = \case+maybeToList' e = case e of L1 {} -> [] R1 (K1 x) -> [x] @@ -320,45 +318,55 @@ -- Utils ------------------------------------------------------------------------------- --- | A silly type synonym to make the signatures look better.--- None of the type variables matter except @any@.--- Read @G@eneric maybe-type G m a y b e any = M1 m a (C1 y U1 :+: C1 b (S1 e (Rec0 any)))- 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 = \case +commuteSum e = case e of L1 x -> R1 x R1 x -> L1 x --- | This class is used internally to get the GHC.Generic Rep into --- a uniform form.--- There are only two instances and no more should be made+-- | 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 (G m a y b e any) any where++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 (Rec0 any)) :+: C1 y U1)) any where+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 (G m a y b e any p)- (G m' a' y' b' e' any' p')+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 r)) -> R1 r- bk = \case- L1 l -> M1 $ L1 $ M1 $ l- R1 r -> M1 $ R1 $ M1 $ M1 $ r+ 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
+ tests/tasty.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-}+module Main where+import Test.Tasty+import Test.Tasty.TH+import Test.Tasty.HUnit+import Test.HUnit+import Generics.Maybe+import Prelude hiding (maybe)+import GHC.Generics+import Control.Exception+import Control.Monad++main :: IO ()+main = $(defaultMainGenerator)++data Nat = Zero | Succ Nat deriving (Eq, Show, Generic)+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'++case_fromMaybe_Fail = fromMaybe 'a' Fail @?= 'a'++case_fromMaybe_Success = fromMaybe 'a' (Success 'b') @?= 'b'++case_fromMaybe_Zero = fromMaybe Zero Zero @?= Zero++case_fromMaybe_Succ = fromMaybe Zero (Succ (Succ Zero)) @?= Succ Zero+++case_maybe_Nothing = maybe (1 :: Int) (+1) Nothing @?= 1++case_maybe_Just = maybe 1 (+1) (Just 1) @?= 2++case_maybe_Fail = maybe (1 :: Int) (+1) Fail @?= 1++case_maybe_Success = maybe 1 (+1) (Success 1) @?= 2++case_maybe_Zero = maybe (Succ Zero) Succ Zero @?= Succ Zero++case_maybe_Succ = maybe (Succ Zero) Succ (Succ (Succ Zero)) + @?= Succ (Succ Zero)++case_isJust_Nothing = isJust Nothing @?= False++case_isJust_Just = isJust (Just 'a') @?= True++case_isJust_Fail = isJust Fail @?= False+ +case_isJust_Successs = isJust (Success 'a') @?= True++case_isJust_Zero = isJust Zero @?= False++case_isJust_Succ = isJust (Succ Zero) @?= True++case_isNothing_Nothing = isNothing Nothing @?= True++case_isNothing_Just = isNothing (Just 'a') @?= False++case_isNothing_Fail = isNothing Fail @?= True++case_isNothing_Success = isNothing (Success 'a') @?= False+ +case_isNothing_Zero = isNothing Zero @?= True++case_isNothing_Succ = isNothing (Succ Zero) @?= False++assertException :: Show a => a -> IO ()+assertException a = handle (\(SomeException e) -> return ())+ $ assertFailure $ "Expected exception: " ++ show a ++case_fromJust_Nothing = assertException (fromJust Nothing :: Char)++case_fromJust_Just = fromJust (Just 'a') @?= 'a'++case_fromJust_Fail = assertException (fromJust Fail :: Char)++case_fromJust_Success = fromJust (Success 'a') @?= 'a'++case_fromJust_Zero = assertException (fromJust Zero :: Nat)++case_fromJust_Succ = fromJust (Succ Zero) @?= Zero++case_listToMaybe_NonEmpty_Maybe = listToMaybe ['a', 'b'] @?= Just 'a'++case_listToMaybe_Empty_Maybe = listToMaybe ([] :: [Char]) @?= Nothing++case_listToMaybe_NonEmpty_Result = listToMaybe ['a', 'b'] @?= Success 'a'++case_listToMaybe_Empty_Result = listToMaybe ([] :: [Char]) @?= Fail++case_listToMaybe_NonEmpty_Nat = listToMaybe [Zero, Succ Zero] @?= Succ Zero++case_listToMaybe_Empty_Nat = listToMaybe ([] :: [Nat]) @?= Zero++case_maybeToList_Just = maybeToList (Just True) @?= [True]++case_maybeToList_Nothing = maybeToList Nothing @?= ([] :: [Bool])++case_maybeToList_Success = maybeToList (Success True) @?= [True]++case_maybeToList_Fail = maybeToList Fail @?= ([] :: [Bool])++case_maybeToList_Succ = maybeToList (Succ Zero) @?= [Zero]++case_maybeToList_Zero = maybeToList Zero @?= [] ++case_catMaybes_Maybe = catMaybes [Just True, Nothing, Just False] + @?= [True,False]++case_catMaybes_Result = catMaybes [Success True, Fail, Success False]+ @?= [True,False]++case_catMaybes_Nat = catMaybes [Succ Zero, Zero, Succ Zero]+ @?= [Zero,Zero]++case_mapMaybe_Maybe + = mapMaybe (\x -> if x then Just "True" else Nothing) [True, False, True]+ @?= ["True","True"]++case_mapMaybe_Result+ = mapMaybe (\x -> if x then Success "True" else Fail) [True, False, True]+ @?= ["True","True"]++case_mapMaybe_Nat + = mapMaybe (\x -> if x then Succ Zero else Zero) [True, False, True]+ @?= [Zero,Zero]++