total 1.0.5 → 1.0.6

raw patch · 3 files changed

+80/−20 lines, 3 files

Files

• src/Lens/Family/Complete.hs +68/−0
• src/Lens/Family/Total.hs +6/−17
• total.cabal +6/−3

@@ -0,0 +1,68 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE TypeOperators     #-}++module Lens.Family.Complete+    ( Full(..)+    , GFull(..)+    , _cocase+    , at++    -- * Re-exports+    , (&)+    , (&&&)+    ) where++import Data.Functor.Identity+import Data.Function ((&))+import Control.Arrow ((&&&))+import GHC.Generics++-- A typeclass for trivially inhabited types+class Full a where+    trivial :: x -> a++    default trivial :: (Generic a, GFull (Rep a)) => x -> a+    trivial = to . gtrivial++instance Full () where+    trivial = const ()++instance (Full a, Full b) => Full (a, b) where+    trivial = trivial &&& trivial++instance Full a => Full (Either a b) where+    trivial = Left . trivial++class GFull f where+    gtrivial :: x -> f a++instance GFull U1 where+    gtrivial = const U1++instance (GFull a, GFull b) => GFull (a :*: b) where+    gtrivial x = gtrivial x :*: gtrivial x++instance Full a => GFull (K1 i a) where+    gtrivial = K1 . trivial++instance GFull a => GFull (M1 i c a) where+    gtrivial = M1 . gtrivial++instance GFull a => GFull (a :+: b) where+    gtrivial = L1 . gtrivial++-- | Synonym for `trivial`, used to check if a copattern is complete+_cocase :: Full a => x -> a+_cocase = trivial++-- | Copattern match on a `Lens.Family.Traversal`+at+    :: ((() -> Identity b) -> s -> Identity t)+    -> (i -> b)+    -> (i -> s)+    -> i+    -> t+at p f g = convert p . (f &&& g)+  where+  convert p' (b, s) = runIdentity $ p' (const $ Identity $ b) s

@@ -1,7 +1,6 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE TypeOperators     #-}-{-# LANGUAGE CPP               #-}  -- | This module lets you exhaustively pattern match on types using -- `Lens.Family.Lens`es, `Lens.Family.Traversal`s, or `Lens.Family.Prism`s.@@ -92,6 +91,7 @@  module Lens.Family.Total (       Empty(..)+    , GEmpty(..)     , _case     , _default     , on@@ -102,9 +102,7 @@     ) where  import Data.Void (Void, absurd)-#if __GLASGOW_HASKELL__ >= 710 import Data.Function ((&))-#endif import GHC.Generics  -- | A type class for uninhabited types@@ -115,7 +113,7 @@     impossible = gimpossible . from  instance Empty Void where-     impossible = absurd+    impossible = absurd  instance (Empty a, Empty b) => Empty (Either a b) where     impossible (Left  a) = impossible a@@ -154,18 +152,9 @@  -- | Pattern match on a `Lens.Family.Traversal` on-    :: ((a -> Either a Void) -> i -> Either l r)-    -> (l -> o)+    :: ((a -> Either a Void) -> s -> Either a r)+    -> (a -> o)     -> (r -> o)-    -> i+    -> s     -> o-on p f g x = case p Left x of-    Left  l -> f l-    Right r -> g r--#if __GLASGOW_HASKELL__ < 710--- | Operator for post-fix function application-(&) :: a -> (a -> b) -> b-x & f = f x-infixl 1 &-#endif+on p f g = either f g . p Left

@@ -1,6 +1,6 @@ Name: total-Version: 1.0.5-Cabal-Version: >=1.8.0.2+Version: 1.0.6+Cabal-Version: >=1.10 Build-Type: Simple Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 License: BSD3@@ -23,5 +23,8 @@     Build-Depends:         base     >= 4       && < 5  ,         void     >= 0.4     && < 0.8-    Exposed-Modules: Lens.Family.Total+    Exposed-Modules:+      Lens.Family.Total+      Lens.Family.Complete     GHC-Options: -Wall+    Default-Language: Haskell2010