{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Extensible.Plain
-- Copyright   :  (c) Fumiaki Kinoshita 2018
-- License     :  BSD3
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--
------------------------------------------------------------------------
module Data.Extensible.Plain (
    AllOf
  , OneOf
  , (<%)
  , pluck
  , bury
  , (<%|)
  , accessing
  ) where
import Data.Extensible.Internal.Rig
import Data.Extensible.Class
import Data.Extensible.Product
import Data.Extensible.Sum
import Data.Functor.Identity
import Data.Extensible.Wrapper
import Data.Coerce
import Data.Profunctor.Unsafe

-- | Alias for plain products
type AllOf xs = xs :& Identity

-- | Alias for plain sums
type OneOf xs = xs :/ Identity

-- | Add a plain value to a product.
(<%) :: x -> AllOf xs -> AllOf (x ': xs)
<% :: x -> AllOf xs -> AllOf (x : xs)
(<%) = Identity x -> AllOf xs -> AllOf (x : xs)
forall k (h :: k -> *) (x :: k) (xs :: [k]).
h x -> (xs :& h) -> (x : xs) :& h
(<:) (Identity x -> AllOf xs -> AllOf (x : xs))
-> (x -> Identity x) -> x -> AllOf xs -> AllOf (x : xs)
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# x -> Identity x
forall a. a -> Identity a
Identity
{-# INLINE (<%) #-}
infixr 5 <%

-- | Extract a plain value.
pluck :: (x ∈ xs) => AllOf xs -> x
pluck :: AllOf xs -> x
pluck = Optic' (->) (Const x) (AllOf xs) (Identity x)
-> (Identity x -> x) -> AllOf xs -> x
forall r s a. Optic' (->) (Const r) s a -> (a -> r) -> s -> r
views Optic' (->) (Const x) (AllOf xs) (Identity x)
forall k (x :: k) (xs :: [k]) (f :: * -> *) (p :: * -> * -> *)
       (t :: [k] -> (k -> *) -> *) (h :: k -> *).
(x ∈ xs, Extensible f p t, ExtensibleConstr t xs h x) =>
Optic' p f (t xs h) (h x)
piece Identity x -> x
forall a. Identity a -> a
runIdentity
{-# INLINE pluck #-}

-- | Embed a plain value.
bury :: (x ∈ xs) => x -> OneOf xs
bury :: x -> OneOf xs
bury = Identity x -> OneOf xs
forall k (x :: k) (xs :: [k]) (h :: k -> *).
(x ∈ xs) =>
h x -> xs :/ h
embed (Identity x -> OneOf xs) -> (x -> Identity x) -> x -> OneOf xs
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# x -> Identity x
forall a. a -> Identity a
Identity
{-# INLINE bury #-}

-- | Naive pattern matching for a plain value.
(<%|) :: (x -> r) -> (OneOf xs -> r) -> OneOf (x ': xs) -> r
<%| :: (x -> r) -> (OneOf xs -> r) -> OneOf (x : xs) -> r
(<%|) = (Identity x -> r) -> (OneOf xs -> r) -> OneOf (x : xs) -> r
forall k (h :: k -> *) (x :: k) r (xs :: [k]).
(h x -> r) -> ((xs :/ h) -> r) -> ((x : xs) :/ h) -> r
(<:|) ((Identity x -> r) -> (OneOf xs -> r) -> OneOf (x : xs) -> r)
-> ((x -> r) -> Identity x -> r)
-> (x -> r)
-> (OneOf xs -> r)
-> OneOf (x : xs)
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((x -> r) -> (Identity x -> x) -> Identity x -> r
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible b a) =>
p b c -> q a b -> p a c
.# Identity x -> x
forall a. Identity a -> a
runIdentity)
infixr 1 <%|

-- | An accessor for newtype constructors.
accessing :: (Coercible x a, x ∈ xs, Extensible f p t, ExtensibleConstr t xs Identity x) => (a -> x) -> Optic' p f (t xs Identity) a
accessing :: (a -> x) -> Optic' p f (t xs Identity) a
accessing c :: a -> x
c = Optic' p f (t xs Identity) (Identity x)
forall k (x :: k) (xs :: [k]) (f :: * -> *) (p :: * -> * -> *)
       (t :: [k] -> (k -> *) -> *) (h :: k -> *).
(x ∈ xs, Extensible f p t, ExtensibleConstr t xs h x) =>
Optic' p f (t xs h) (h x)
piece Optic' p f (t xs Identity) (Identity x)
-> (p a (f a) -> p (Identity x) (f (Identity x)))
-> Optic' p f (t xs Identity) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p x (f x) -> p (Identity x) (f (Identity x))
forall k (h :: k -> *) (f :: * -> *) (p :: * -> * -> *) (v :: k).
(Wrapper h, Functor f, Profunctor p) =>
Optic' p f (h v) (Repr h v)
_Wrapper (p x (f x) -> p (Identity x) (f (Identity x)))
-> (p a (f a) -> p x (f x))
-> p a (f a)
-> p (Identity x) (f (Identity x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> a) -> (f a -> f x) -> p a (f a) -> p x (f x)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap x -> a
forall a b. Coercible a b => a -> b
coerce ((a -> x) -> f a -> f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> x
c)
{-# INLINE accessing #-}