generic-deriving 1.5.0 → 1.6

raw patch · 4 files changed

+79/−4 lines, 4 filesdep ~template-haskellPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• generic-deriving.cabal +3/−3
• src/Generics/Deriving.hs +2/−0
• src/Generics/Deriving/Copoint.hs +73/−0
• src/Generics/Deriving/TH.hs +1/−1

@@ -1,5 +1,5 @@ name:                   generic-deriving
-version:                1.5.0
+version:                1.6
 synopsis:               Generic programming library for generalised deriving.
 description:
 
@@ -23,7 +23,7 @@ stability:              experimental
 build-type:             Simple
 cabal-version:          >= 1.6
-tested-with:            GHC == 7.0.3, GHC == 7.2.1, GHC == 7.4.1, GHC == 7.6.1
+tested-with:            GHC == 7.0.3, GHC == 7.2.1, GHC == 7.4.1, GHC == 7.6.1, GHC == 7.7.20130624
 extra-source-files:     examples/Examples.hs
 
 source-repository head
@@ -35,7 +35,7 @@   exposed-modules:      Generics.Deriving
                         Generics.Deriving.Base
                         Generics.Deriving.Instances
-
+                        Generics.Deriving.Copoint
                         Generics.Deriving.ConNames
                         Generics.Deriving.Enum
                         Generics.Deriving.Eq

@@ -2,6 +2,7 @@ module Generics.Deriving (
 
     module Generics.Deriving.Base,
+    module Generics.Deriving.Copoint, 
     module Generics.Deriving.ConNames,
     module Generics.Deriving.Enum,
     module Generics.Deriving.Eq,
@@ -12,6 +13,7 @@   ) where
 
 import Generics.Deriving.Base
+import Generics.Deriving.Copoint
 import Generics.Deriving.ConNames
 import Generics.Deriving.Enum
 import Generics.Deriving.Eq

@@ -0,0 +1,73 @@+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE DefaultSignatures #-}
+#endif
+
+module Generics.Deriving.Copoint (
+  -- * GCopoint class
+    GCopoint(..), 
+
+  -- * Default method
+  gcopointdefault
+
+  ) where
+
+import Generics.Deriving.Base
+import Generics.Deriving.Instances ()
+
+
+--------------------------------------------------------------------------------
+-- Generic copoint
+--------------------------------------------------------------------------------
+
+-- General copoint may return 'Nothing'
+
+class GCopoint' t where
+    gcopoint' :: t a -> Maybe a
+
+instance GCopoint' U1 where
+    gcopoint' U1 = Nothing
+
+instance GCopoint' Par1 where
+    gcopoint' (Par1 a) = Just a
+
+instance GCopoint' (K1 i c) where
+    gcopoint' _ = Nothing
+
+instance GCopoint' f => GCopoint' (M1 i c f) where
+    gcopoint' (M1 a) = gcopoint' a
+
+instance (GCopoint' f, GCopoint' g) => GCopoint' (f :+: g) where
+    gcopoint' (L1 a) = gcopoint' a
+    gcopoint' (R1 a) = gcopoint' a
+
+-- Favours left "hole" for copoint
+instance (GCopoint' f, GCopoint' g) => GCopoint' (f :*: g) where
+    gcopoint' (a :*: b) = case (gcopoint' a) of  
+                            Just x -> Just x
+                            Nothing -> gcopoint' b
+
+instance (GCopoint f) => GCopoint' (Rec1 f) where
+    gcopoint' (Rec1 a) = Just $ gcopoint a 
+
+instance (GCopoint f, GCopoint' g) => GCopoint' (f :.: g) where
+    gcopoint' (Comp1 x) = gcopoint' . gcopoint $ x
+
+class GCopoint d where
+  gcopoint :: d a -> a
+#if __GLASGOW_HASKELL__ >= 701
+  default gcopoint :: (Generic1 d, GCopoint' (Rep1 d))
+                   => (d a -> a)
+  gcopoint = gcopointdefault
+#endif
+
+gcopointdefault :: (Generic1 d, GCopoint' (Rep1 d))
+                => d a -> a
+gcopointdefault x = case (gcopoint' . from1 $ x) of
+                      Just x' -> x'
+                      Nothing -> error "Data type is not copointed"
+
+-- instance (Generic1 d, GCopoint' (Rep1 d)) => GCopoint d

@@ -109,7 +109,7 @@   let typ q = foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT q) 
                 (typeVariables i)
 #if __GLASGOW_HASKELL__ >= 707
-  let tyIns = TySynInstD ''Rep (fmap (TySynEqn [typ (genRepName 0 t)]) [typ t])
+  let tyIns = TySynInstD ''Rep (TySynEqn [typ t] (typ (genRepName 0 t)))
 #else
   let tyIns = TySynInstD ''Rep [typ t] (typ (genRepName 0 t))
 #endif