{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

module Opaleye.SQLite.Internal.Unpackspec where

import qualified Opaleye.SQLite.Internal.PackMap as PM
import qualified Opaleye.SQLite.Internal.Column as IC
import qualified Opaleye.SQLite.Column as C

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

import qualified Opaleye.SQLite.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).
  --
  -- You can create 'Unpackspec's by hand using 'unpackspecColumn' and
  -- the 'Profunctor', 'ProductProfunctor' and 'SumProfunctor'
  -- operations.  However, in practice users should almost never need
  -- to create or manipulate them.  Typically they will be created
  -- automatically by the 'D.Default' instance.
  Unpackspec (PM.PackMap HPQ.PrimExpr HPQ.PrimExpr columns columns')

-- | Target the single 'HPQ.PrimExpr' inside a 'C.Column'
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
                   ((forall (f :: * -> *).
 Applicative f =>
 (PrimExpr -> f PrimExpr) -> Column a -> f (Column a))
-> PackMap PrimExpr PrimExpr (Column a) (Column a)
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap (\PrimExpr -> f PrimExpr
f (IC.Column pe) -> (PrimExpr -> Column a) -> f PrimExpr -> f (Column a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimExpr -> Column a
forall a. PrimExpr -> Column a
IC.Column (PrimExpr -> f PrimExpr
f PrimExpr
pe)))

-- | 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
  empty :: Unpackspec () ()
empty = Unpackspec () ()
forall (p :: * -> * -> *). Applicative (p ()) => p () ()
PP.defaultEmpty
  ***! :: Unpackspec a b -> Unpackspec a' b' -> Unpackspec (a, a') (b, b')
(***!) = Unpackspec a b -> Unpackspec a' b' -> Unpackspec (a, a') (b, b')
forall (p :: * -> * -> *) a a' b b'.
(Applicative (p (a, a')), Profunctor p) =>
p a b -> p a' b' -> p (a, a') (b, b')
PP.defaultProfunctorProduct

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)

--}