{-# 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.Column as C

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 columns columns' =
  -- | An 'Unpackspec' @columns@ @columns'@ allows you to extract and
  -- modify a sequence of 'HPQ.PrimExpr's inside a value of type
  -- @columns@.
  --
  -- For example, the 'Default' instance of type 'Unpackspec' @(Column
  -- a, Column b)@ @(Column a, Column b)@ allows you to manipulate or
  -- extract the two 'HPQ.PrimExpr's inside a @(Column a, Column b)@.  The
  -- 'Default' instance of type @Foo (Column a) (Column b) (Column 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 'unpackspecColumn' and the
  -- 'Profunctor', 'ProductProfunctor' and 'SumProfunctor' operations.
  Unpackspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr columns columns')

{-# DEPRECATED unpackspecColumn "Use 'unpackspecField' instead.  Will be removed in version 0.8." #-}
unpackspecColumn :: Unpackspec (C.Column a) (C.Column a)
unpackspecColumn :: Unpackspec (Column a) (Column a)
unpackspecColumn = PackMap PrimExpr PrimExpr (Column a) (Column a)
-> Unpackspec (Column a) (Column a)
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec ((Column a -> PrimExpr)
-> (PrimExpr -> Column a)
-> PackMap PrimExpr PrimExpr (Column a) (Column a)
forall s a b t. (s -> a) -> (b -> t) -> PackMap a b s t
PM.iso Column a -> PrimExpr
forall a. Column a -> PrimExpr
IC.unColumn PrimExpr -> Column a
forall pgType. PrimExpr -> Column pgType
IC.Column)

-- | Target the single 'HPQ.PrimExpr' inside a 'C.Column'
unpackspecField :: Unpackspec (C.Column a) (C.Column a)
unpackspecField :: Unpackspec (Column a) (Column a)
unpackspecField = PackMap PrimExpr PrimExpr (Column a) (Column a)
-> Unpackspec (Column a) (Column a)
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec ((Column a -> PrimExpr)
-> (PrimExpr -> Column a)
-> PackMap PrimExpr PrimExpr (Column a) (Column a)
forall s a b t. (s -> a) -> (b -> t) -> PackMap a b s t
PM.iso Column a -> PrimExpr
forall a. Column a -> PrimExpr
IC.unColumn PrimExpr -> Column a
forall pgType. PrimExpr -> Column pgType
IC.Column)

-- | Modify all the targeted 'HPQ.PrimExpr's
runUnpackspec :: Applicative f
                 => Unpackspec columns b
                 -> (HPQ.PrimExpr -> f HPQ.PrimExpr)
                 -> columns -> f b
runUnpackspec :: Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
runUnpackspec (Unpackspec PackMap PrimExpr PrimExpr columns b
f) = PackMap PrimExpr PrimExpr columns b
-> (PrimExpr -> f PrimExpr) -> columns -> f b
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 :: Unpackspec s t -> s -> [PrimExpr]
collectPEs Unpackspec s t
unpackspec = ([PrimExpr], t) -> [PrimExpr]
forall a b. (a, b) -> a
fst (([PrimExpr], t) -> [PrimExpr])
-> (s -> ([PrimExpr], t)) -> s -> [PrimExpr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unpackspec s t
-> (PrimExpr -> ([PrimExpr], PrimExpr)) -> s -> ([PrimExpr], t)
forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
runUnpackspec Unpackspec s t
unpackspec PrimExpr -> ([PrimExpr], PrimExpr)
forall b. b -> ([b], b)
f
  where f :: b -> ([b], b)
f b
pe = ([b
pe], b
pe)

instance D.Default Unpackspec (C.Column a) (C.Column a) where
  def :: Unpackspec (Column a) (Column a)
def = Unpackspec (Column a) (Column a)
forall a. Unpackspec (Column a) (Column a)
unpackspecColumn

-- {

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

instance Functor (Unpackspec a) where
  fmap :: (a -> b) -> Unpackspec a a -> Unpackspec a b
fmap a -> b
f (Unpackspec PackMap PrimExpr PrimExpr a a
g) = PackMap PrimExpr PrimExpr a b -> Unpackspec a b
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec ((a -> b)
-> PackMap PrimExpr PrimExpr a a -> PackMap PrimExpr PrimExpr a b
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 :: a -> Unpackspec a a
pure = PackMap PrimExpr PrimExpr a a -> Unpackspec a a
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec (PackMap PrimExpr PrimExpr a a -> Unpackspec a a)
-> (a -> PackMap PrimExpr PrimExpr a a) -> a -> Unpackspec a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PackMap PrimExpr PrimExpr a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Unpackspec PackMap PrimExpr PrimExpr a (a -> b)
f <*> :: Unpackspec a (a -> b) -> Unpackspec a a -> Unpackspec a b
<*> Unpackspec PackMap PrimExpr PrimExpr a a
x = PackMap PrimExpr PrimExpr a b -> Unpackspec a b
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec (PackMap PrimExpr PrimExpr a (a -> b)
f PackMap PrimExpr PrimExpr a (a -> b)
-> PackMap PrimExpr PrimExpr a a -> PackMap PrimExpr PrimExpr a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackMap PrimExpr PrimExpr a a
x)

instance Profunctor Unpackspec where
  dimap :: (a -> b) -> (c -> d) -> Unpackspec b c -> Unpackspec a d
dimap a -> b
f c -> d
g (Unpackspec PackMap PrimExpr PrimExpr b c
q) = PackMap PrimExpr PrimExpr a d -> Unpackspec a d
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec ((a -> b)
-> (c -> d)
-> PackMap PrimExpr PrimExpr b c
-> PackMap PrimExpr PrimExpr a d
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 :: b -> Unpackspec a b
purePP = b -> Unpackspec a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: Unpackspec a (b -> c) -> Unpackspec a b -> Unpackspec a c
(****) = Unpackspec a (b -> c) -> Unpackspec a b -> Unpackspec a c
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 +++! :: Unpackspec a b
-> Unpackspec a' b' -> Unpackspec (Either a a') (Either b b')
+++! Unpackspec PackMap PrimExpr PrimExpr a' b'
x2 = PackMap PrimExpr PrimExpr (Either a a') (Either b b')
-> Unpackspec (Either a a') (Either b b')
forall columns columns'.
PackMap PrimExpr PrimExpr columns columns'
-> Unpackspec columns columns'
Unpackspec (PackMap PrimExpr PrimExpr a b
x1 PackMap PrimExpr PrimExpr a b
-> PackMap PrimExpr PrimExpr a' b'
-> PackMap PrimExpr PrimExpr (Either a a') (Either b b')
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)

--}