1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE MagicHash #-}
4{-# LANGUAGE Rank2Types #-}
5{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE PolyKinds #-}
8-----------------------------------------------------------------------------
9-- |
10-- Module      :  GHC.Generics.Lens
11-- Copyright   :  (C) 2012-16 Edward Kmett
12-- License     :  BSD-style (see the file LICENSE)
13-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
14-- Stability   :  experimental
15-- Portability :  GHC
16--
17-- Note: @GHC.Generics@ exports a number of names that collide with @Control.Lens@.
18--
19-- You can use hiding or imports to mitigate this to an extent, and the following imports,
20-- represent a fair compromise for user code:
21--
22-- > import Control.Lens hiding (Rep)
23-- > import GHC.Generics hiding (from, to)
24--
25-- You can use 'generic' to replace 'GHC.Generics.from' and 'GHC.Generics.to' from @GHC.Generics@,
26-- and probably won't be explicitly referencing 'Control.Lens.Representable.Rep' from @Control.Lens@
27-- in code that uses generics.
28--
29-- This module provides compatibility with older GHC versions by using the
30-- <http://hackage.haskell.org/package/generic-deriving generic-deriving>
31-- package.
32----------------------------------------------------------------------------
33module GHC.Generics.Lens
34  (
35    generic
36  , generic1
37  , _V1
38  , _U1
39  , _Par1
40  , _Rec1
41  , _K1
42  , _M1
43  , _L1
44  , _R1
45  , _UAddr
46  , _UChar
47  , _UDouble
48  , _UFloat
49  , _UInt
50  , _UWord
51  ) where
52
53import           Control.Lens
54import           GHC.Exts (Char(..), Double(..), Float(..),
55                           Int(..), Ptr(..), Word(..))
56import qualified GHC.Generics as Generic
57import           GHC.Generics hiding (from, to)
58
59#if !(MIN_VERSION_base(4,9,0))
60import           Generics.Deriving.Base hiding (from, to)
61#endif
62
63-- $setup
64-- >>> :set -XNoOverloadedStrings
65-- >>> import Control.Lens
66
67-- | Convert from the data type to its representation (or back)
68--
69-- >>> "hello"^.generic.from generic :: String
70-- "hello"
71generic :: (Generic a, Generic b) => Iso a b (Rep a g) (Rep b h)
72generic = iso Generic.from Generic.to
73{-# INLINE generic #-}
74
75-- | Convert from the data type to its representation (or back)
76generic1 :: (Generic1 f, Generic1 g) => Iso (f a) (g b) (Rep1 f a) (Rep1 g b)
77generic1 = iso from1 to1
78{-# INLINE generic1 #-}
79
80_V1 :: Over p f (V1 s) (V1 t) a b
81_V1 _ = absurd where
82  absurd !_a = undefined
83{-# INLINE _V1 #-}
84
85_U1 :: Iso (U1 p) (U1 q) () ()
86_U1 = iso (const ()) (const U1)
87{-# INLINE _U1 #-}
88
89_Par1 :: Iso (Par1 p) (Par1 q) p q
90_Par1 = iso unPar1 Par1
91{-# INLINE _Par1 #-}
92
93_Rec1 :: Iso (Rec1 f p) (Rec1 g q) (f p) (g q)
94_Rec1 = iso unRec1 Rec1
95{-# INLINE _Rec1 #-}
96
97_K1 :: Iso (K1 i c p) (K1 j d q) c d
98_K1 = iso unK1 K1
99{-# INLINE _K1 #-}
100
101_M1 :: Iso (M1 i c f p) (M1 j d g q) (f p) (g q)
102_M1 = iso unM1 M1
103{-# INLINE _M1 #-}
104
105_L1 :: Prism' ((f :+: g) a) (f a)
106_L1 = prism remitter reviewer
107  where
108  remitter = L1
109  reviewer (L1 l) = Right l
110  reviewer x = Left x
111{-# INLINE _L1 #-}
112
113-- | You can access fields of `data (f :*: g) p` by using it's `Field1` and `Field2` instances
114
115_R1 :: Prism' ((f :+: g) a) (g a)
116_R1 = prism remitter reviewer
117  where
118  remitter = R1
119  reviewer (R1 l) = Right l
120  reviewer x = Left x
121{-# INLINE _R1 #-}
122
123_UAddr :: Iso (UAddr p) (UAddr q) (Ptr c) (Ptr d)
124_UAddr = iso remitter reviewer
125  where
126  remitter (UAddr a) = Ptr a
127  reviewer (Ptr a) = UAddr a
128{-# INLINE _UAddr #-}
129
130_UChar :: Iso (UChar p) (UChar q) Char Char
131_UChar = iso remitter reviewer
132  where
133  remitter (UChar c) = C# c
134  reviewer (C# c) = UChar c
135{-# INLINE _UChar #-}
136
137_UDouble :: Iso (UDouble p) (UDouble q) Double Double
138_UDouble = iso remitter reviewer
139  where
140  remitter (UDouble d) = D# d
141  reviewer (D# d) = UDouble d
142{-# INLINE _UDouble #-}
143
144_UFloat :: Iso (UFloat p) (UFloat q) Float Float
145_UFloat = iso remitter reviewer
146  where
147  remitter (UFloat f) = F# f
148  reviewer (F# f) = UFloat f
149{-# INLINE _UFloat #-}
150
151_UInt :: Iso (UInt p) (UInt q) Int Int
152_UInt = iso remitter reviewer
153  where
154  remitter (UInt i) = I# i
155  reviewer (I# i) = UInt i
156{-# INLINE _UInt #-}
157
158_UWord :: Iso (UWord p) (UWord q) Word Word
159_UWord = iso remitter reviewer
160  where
161  remitter (UWord w) = W# w
162  reviewer (W# w) = UWord w
163{-# INLINE _UWord #-}
164