{-# OPTIONS_HADDOCK not-home #-}

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

module Opaleye.Internal.Unpackspec where

import qualified Opaleye.Internal.PackMap as PM
import qualified Opaleye.Internal.Column as IC
import qualified Opaleye.Field as F

import           Control.Applicative (Applicative, pure, (<*>))
import           Data.Profunctor (Profunctor, dimap)
import           Data.Profunctor.Product (ProductProfunctor)
import qualified Data.Profunctor.Product as PP
import qualified Data.Profunctor.Product.Default as D

import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ

newtype Unpackspec fields fields' =
  -- | An 'Unpackspec' @fields@ @fields'@ allows you to extract and
  -- modify a sequence of 'HPQ.PrimExpr's inside a value of type
  -- @fields@.
  --
  -- For example, the 'Default' instance of type 'Unpackspec' @(Field
  -- a, Field b)@ @(Field a, Field b)@ allows you to manipulate or
  -- extract the two 'HPQ.PrimExpr's inside a @(Field a, Field b)@.  The
  -- 'Default' instance of type @Foo (Field a) (Field b) (Field c)@
  -- will allow you to manipulate or extract the three 'HPQ.PrimExpr's
  -- contained therein (for a user-defined product type @Foo@, assuming
  -- the @makeAdaptorAndInstance@ splice from
  -- @Data.Profunctor.Product.TH@ has been run).
  --
  -- Users should almost never need to create or manipulate
  -- `Unpackspec`s.  Typically they will be created automatically by
  -- the 'D.Default' instance.  If you really need to you can create
  -- 'Unpackspec's by hand using 'unpackspecField' and the
  -- 'Profunctor', 'ProductProfunctor' and 'SumProfunctor' operations.
  Unpackspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr fields fields')

-- | Target the single 'HPQ.PrimExpr' inside a 'F.Field n'
unpackspecField :: Unpackspec (F.Field_ n a) (F.Field_ n a)
unpackspecField :: forall (n :: Nullability) a. Unpackspec (Field_ n a) (Field_ n a)
unpackspecField = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (forall s a b t. (s -> a) -> (b -> t) -> PackMap a b s t
PM.iso forall (n :: Nullability) a. Field_ n a -> PrimExpr
IC.unColumn forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
IC.Column)

-- | Modify all the targeted 'HPQ.PrimExpr's
runUnpackspec :: Applicative f
                 => Unpackspec columns b
                 -> (HPQ.PrimExpr -> f HPQ.PrimExpr)
                 -> columns -> f b
runUnpackspec :: forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
runUnpackspec (Unpackspec PackMap PrimExpr PrimExpr columns b
f) = forall (f :: * -> *) a b s t.
Applicative f =>
PackMap a b s t -> (a -> f b) -> s -> f t
PM.traversePM PackMap PrimExpr PrimExpr columns b
f

-- | Extract all the targeted 'HPQ.PrimExpr's
collectPEs :: Unpackspec s t -> s -> [HPQ.PrimExpr]
collectPEs :: forall s t. Unpackspec s t -> s -> [PrimExpr]
collectPEs Unpackspec s t
unpackspec = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
runUnpackspec Unpackspec s t
unpackspec forall {b}. b -> ([b], b)
f
  where f :: b -> ([b], b)
f b
pe = ([b
pe], b
pe)

instance D.Default Unpackspec (F.Field_ n a) (F.Field_ n a) where
  def :: Unpackspec (Field_ n a) (Field_ n a)
def = forall (n :: Nullability) a. Unpackspec (Field_ n a) (Field_ n a)
unpackspecField

-- {

-- Boilerplate instance definitions.  Theoretically, these are derivable.

instance Functor (Unpackspec a) where
  fmap :: forall a b. (a -> b) -> Unpackspec a a -> Unpackspec a b
fmap a -> b
f (Unpackspec PackMap PrimExpr PrimExpr a a
g) = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PackMap PrimExpr PrimExpr a a
g)

instance Applicative (Unpackspec a) where
  pure :: forall a. a -> Unpackspec a a
pure = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Unpackspec PackMap PrimExpr PrimExpr a (a -> b)
f <*> :: forall a b.
Unpackspec a (a -> b) -> Unpackspec a a -> Unpackspec a b
<*> Unpackspec PackMap PrimExpr PrimExpr a a
x = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (PackMap PrimExpr PrimExpr a (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackMap PrimExpr PrimExpr a a
x)

instance Profunctor Unpackspec where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Unpackspec b c -> Unpackspec a d
dimap a -> b
f c -> d
g (Unpackspec PackMap PrimExpr PrimExpr b c
q) = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap a -> b
f c -> d
g PackMap PrimExpr PrimExpr b c
q)

instance ProductProfunctor Unpackspec where
  purePP :: forall b a. b -> Unpackspec a b
purePP = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: forall a a b.
Unpackspec a (a -> b) -> Unpackspec a a -> Unpackspec a b
(****) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

instance PP.SumProfunctor Unpackspec where
  Unpackspec PackMap PrimExpr PrimExpr a b
x1 +++! :: forall a b a' b'.
Unpackspec a b
-> Unpackspec a' b' -> Unpackspec (Either a a') (Either b b')
+++! Unpackspec PackMap PrimExpr PrimExpr a' b'
x2 = forall fields fields'.
PackMap PrimExpr PrimExpr fields fields'
-> Unpackspec fields fields'
Unpackspec (PackMap PrimExpr PrimExpr a b
x1 forall (p :: * -> * -> *) a b a' b'.
SumProfunctor p =>
p a b -> p a' b' -> p (Either a a') (Either b b')
PP.+++! PackMap PrimExpr PrimExpr a' b'
x2)

--}