{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

module Opaleye.Internal.TableMaker where

import qualified Opaleye.Column as C
import qualified Opaleye.Internal.Column as IC
import qualified Opaleye.Internal.PackMap as PM
import qualified Opaleye.Internal.Unpackspec as U

import           Data.Profunctor (Profunctor, dimap)
import           Data.Profunctor.Product (ProductProfunctor)
import qualified Data.Profunctor.Product as PP
import           Data.Profunctor.Product.Default (Default, def)

import           Control.Applicative (Applicative, pure, (<*>))

import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ


-- If we switch to a more lens-like approach to PackMap this should be
-- the equivalent of a Setter
newtype ViewColumnMaker strings columns =
  ViewColumnMaker (PM.PackMap () () strings columns)

runViewColumnMaker :: ViewColumnMaker strings tablecolumns ->
                       strings -> tablecolumns
runViewColumnMaker :: ViewColumnMaker strings tablecolumns -> strings -> tablecolumns
runViewColumnMaker (ViewColumnMaker PackMap () () strings tablecolumns
f) = PackMap () () strings tablecolumns
-> (() -> ()) -> strings -> tablecolumns
forall a b s t. PackMap a b s t -> (a -> b) -> s -> t
PM.overPM PackMap () () strings tablecolumns
f () -> ()
forall a. a -> a
id

{-# DEPRECATED ColumnMaker "Use Unpackspec instead" #-}
type ColumnMaker = U.Unpackspec

{-# DEPRECATED runColumnMaker "Use runUnpackspec instead" #-}
runColumnMaker :: Applicative f
                  => ColumnMaker tablecolumns columns
                  -> (HPQ.PrimExpr -> f HPQ.PrimExpr)
                  -> tablecolumns -> f columns
runColumnMaker :: ColumnMaker tablecolumns columns
-> (PrimExpr -> f PrimExpr) -> tablecolumns -> f columns
runColumnMaker = ColumnMaker tablecolumns columns
-> (PrimExpr -> f PrimExpr) -> tablecolumns -> f columns
forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
U.runUnpackspec

-- There's surely a way of simplifying this implementation
tableColumn :: ViewColumnMaker String (C.Column a)
tableColumn :: ViewColumnMaker String (Column a)
tableColumn = PackMap () () String (Column a)
-> ViewColumnMaker String (Column a)
forall strings columns.
PackMap () () strings columns -> ViewColumnMaker strings columns
ViewColumnMaker
              ((forall (f :: * -> *).
 Applicative f =>
 (() -> f ()) -> String -> f (Column a))
-> PackMap () () String (Column a)
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> PackMap a b s t
PM.PackMap (\() -> f ()
f String
s -> (() -> Column a) -> f () -> f (Column a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Column a -> () -> Column a
forall a b. a -> b -> a
const (String -> Column a
forall pgType. String -> Column pgType
mkColumn String
s)) (() -> f ()
f ())))
  where mkColumn :: String -> Column pgType
mkColumn = PrimExpr -> Column pgType
forall pgType. PrimExpr -> Column pgType
IC.Column (PrimExpr -> Column pgType)
-> (String -> PrimExpr) -> String -> Column pgType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PrimExpr
HPQ.BaseTableAttrExpr

instance Default ViewColumnMaker String (C.Column a) where
  def :: ViewColumnMaker String (Column a)
def = ViewColumnMaker String (Column a)
forall a. ViewColumnMaker String (Column a)
tableColumn

{-# DEPRECATED column "Use unpackspecColumn instead" #-}
column :: ColumnMaker (C.Column a) (C.Column a)
column :: ColumnMaker (Column a) (Column a)
column = ColumnMaker (Column a) (Column a)
forall a. Unpackspec (Column a) (Column a)
U.unpackspecField

-- {

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

instance Functor (ViewColumnMaker a) where
  fmap :: (a -> b) -> ViewColumnMaker a a -> ViewColumnMaker a b
fmap a -> b
f (ViewColumnMaker PackMap () () a a
g) = PackMap () () a b -> ViewColumnMaker a b
forall strings columns.
PackMap () () strings columns -> ViewColumnMaker strings columns
ViewColumnMaker ((a -> b) -> PackMap () () a a -> PackMap () () a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PackMap () () a a
g)

instance Applicative (ViewColumnMaker a) where
  pure :: a -> ViewColumnMaker a a
pure = PackMap () () a a -> ViewColumnMaker a a
forall strings columns.
PackMap () () strings columns -> ViewColumnMaker strings columns
ViewColumnMaker (PackMap () () a a -> ViewColumnMaker a a)
-> (a -> PackMap () () a a) -> a -> ViewColumnMaker a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PackMap () () a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ViewColumnMaker PackMap () () a (a -> b)
f <*> :: ViewColumnMaker a (a -> b)
-> ViewColumnMaker a a -> ViewColumnMaker a b
<*> ViewColumnMaker PackMap () () a a
x = PackMap () () a b -> ViewColumnMaker a b
forall strings columns.
PackMap () () strings columns -> ViewColumnMaker strings columns
ViewColumnMaker (PackMap () () a (a -> b)
f PackMap () () a (a -> b) -> PackMap () () a a -> PackMap () () a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackMap () () a a
x)

instance Profunctor ViewColumnMaker where
  dimap :: (a -> b) -> (c -> d) -> ViewColumnMaker b c -> ViewColumnMaker a d
dimap a -> b
f c -> d
g (ViewColumnMaker PackMap () () b c
q) = PackMap () () a d -> ViewColumnMaker a d
forall strings columns.
PackMap () () strings columns -> ViewColumnMaker strings columns
ViewColumnMaker ((a -> b) -> (c -> d) -> PackMap () () b c -> PackMap () () 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 () () b c
q)

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

--}