{-# LANGUAGE CPP #-}
-- | parts of lens that would be imported if we depended on it
module LensDefs
  (module LensDefs,
   module Control.Applicative,
   Choice,
   Profunctor,
   Coercible)
   where

import Data.Profunctor
import Data.Profunctor.Unsafe
import Control.Applicative
import Control.Monad.Identity

import Unsafe.Coerce
#if __GLASGOW_HASKELL__ > 707
import GHC.Exts(Coercible)
#else
import GHC.Exts(Constraint)
-- | for ghc-7.6 we don't have coercible
type Coercible a b = (() :: Constraint)
#endif


type Equality' s a = forall p (f :: * -> *). a `p` f a -> s `p` f s

{- | if we write @f' = simple . f@, then the inferred type is

> f' :: (s ~ t, _) => Lens s t a b

which normally will let ghc figure out (a~b). However with the
types that come up in HList this can only be figure out with
concrete types, so we use isSimple instead which also specifies
(a~b).

-}
isSimple :: optic ~ (p a (f a) -> p s (f s)) => optic -> optic
isSimple :: optic -> optic
isSimple = optic -> optic
forall a. a -> a
id
-- alternatively: isSimple x = simple . x . simple

simple :: Equality' a a
simple :: p a (f a) -> p a (f a)
simple = p a (f a) -> p a (f a)
forall a. a -> a
id

-- Used by doctests (which should probably just import Control.Lens...)
infixl 1 &
t
x & :: t -> (t -> t) -> t
& t -> t
f = t -> t
f t
x

infixr 4 %~
p a (Identity a) -> t -> Identity a
l %~ :: (p a (Identity a) -> t -> Identity a) -> p a a -> t -> a
%~ p a a
f = \t
t -> Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> Identity a -> a
forall a b. (a -> b) -> a -> b
$ p a (Identity a) -> t -> Identity a
l ((a -> Identity a) -> p a a -> p a (Identity a)
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap a -> Identity a
forall a. a -> Identity a
Identity p a a
f) t
t

iso :: (Profunctor p, Functor f)
    => (s -> a) -> (b -> t)
    -> p a (f b) -> p s (f t)
iso :: (s -> a) -> (b -> t) -> p a (f b) -> p s (f t)
iso s -> a
sa b -> t
bt = (s -> a) -> (f b -> f t) -> p a (f b) -> p s (f t)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> a
sa ((b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)

-- | iso, except assumes that the functions supplied could
-- be 'Data.Coerce.coerce'
isoNewtype :: (Profunctor p, Functor f,
               Coercible b t, -- Coercible (f b) (f t) -- is really needed but that complicates types later on (since f is forall'd)
               Coercible a s)
    => (s -> a) -> (b -> t)
    -> p a (f b) -> p s (f t)
isoNewtype :: (s -> a) -> (b -> t) -> p a (f b) -> p s (f t)
isoNewtype s -> a
sa b -> t
_bt p a (f b)
x = p a (f b) -> p a (f t)
forall k k k (p :: k -> k -> *) (a :: k) (f :: k -> k) (b :: k)
       (t :: k).
p a (f b) -> p a (f t)
coerceBT p a (f b)
x p a (f t) -> (s -> a) -> p s (f t)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# s -> a
sa
  where coerceBT :: p a (f b) -> p a (f t)
        coerceBT :: p a (f b) -> p a (f t)
coerceBT = p a (f b) -> p a (f t)
forall a b. a -> b
unsafeCoerce

prism :: (b -> t) -> (s -> Either t a)
    -> (forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t))
prism :: (b -> t)
-> (s -> Either t a)
-> forall (p :: * -> * -> *) (f :: * -> *).
   (Choice p, Applicative f) =>
   p a (f b) -> p s (f t)
prism b -> t
bt s -> Either t a
seta = (s -> Either t a)
-> (Either t (f b) -> f t)
-> p (Either t a) (Either t (f b))
-> p s (f t)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap s -> Either t a
seta ((t -> f t) -> (f b -> f t) -> Either t (f b) -> f t
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> f t
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((b -> t) -> f b -> f t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> t
bt)) (p (Either t a) (Either t (f b)) -> p s (f t))
-> (p a (f b) -> p (Either t a) (Either t (f b)))
-> p a (f b)
-> p s (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (f b) -> p (Either t a) (Either t (f b))
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'

prism' :: (a -> s) -> (s -> Maybe a)
    -> (forall p f. (Choice p, Applicative f) => p a (f a) -> p s (f s))
prism' :: (a -> s)
-> (s -> Maybe a)
-> forall (p :: * -> * -> *) (f :: * -> *).
   (Choice p, Applicative f) =>
   p a (f a) -> p s (f s)
prism' a -> s
bs s -> Maybe a
sma = (a -> s)
-> (s -> Either s a)
-> forall (p :: * -> * -> *) (f :: * -> *).
   (Choice p, Applicative f) =>
   p a (f a) -> p s (f s)
forall b t s a.
(b -> t)
-> (s -> Either t a)
-> forall (p :: * -> * -> *) (f :: * -> *).
   (Choice p, Applicative f) =>
   p a (f b) -> p s (f t)
prism a -> s
bs (\s
s -> Either s a -> (a -> Either s a) -> Maybe a -> Either s a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (s -> Either s a
forall a b. a -> Either a b
Left s
s) a -> Either s a
forall a b. b -> Either a b
Right (s -> Maybe a
sma s
s))