{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

module Opaleye.Internal.TableMaker where

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 :: forall strings tablecolumns.
ViewColumnMaker strings tablecolumns -> strings -> tablecolumns
runViewColumnMaker (ViewColumnMaker PackMap () () strings tablecolumns
f) = 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 :: forall (f :: * -> *) tablecolumns columns.
Applicative f =>
ColumnMaker tablecolumns columns
-> (PrimExpr -> f PrimExpr) -> tablecolumns -> f columns
runColumnMaker = forall (f :: * -> *) tablecolumns columns.
Applicative f =>
ColumnMaker tablecolumns columns
-> (PrimExpr -> f PrimExpr) -> tablecolumns -> f columns
U.runUnpackspec

-- There's surely a way of simplifying this implementation
tableColumn :: ViewColumnMaker String (IC.Field_ n a)
tableColumn :: forall (n :: Nullability) a. ViewColumnMaker String (Field_ n a)
tableColumn = forall strings columns.
PackMap () () strings columns -> ViewColumnMaker strings columns
ViewColumnMaker
              (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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const (forall {n :: Nullability} {sqlType}. String -> Field_ n sqlType
mkColumn String
s)) (() -> f ()
f ())))
  where mkColumn :: String -> Field_ n sqlType
mkColumn = forall (n :: Nullability) sqlType. PrimExpr -> Field_ n sqlType
IC.Column forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PrimExpr
HPQ.BaseTableAttrExpr

instance Default ViewColumnMaker String (IC.Field_ n a) where
  def :: ViewColumnMaker String (Field_ n a)
def = forall (n :: Nullability) a. ViewColumnMaker String (Field_ n a)
tableColumn

{-# DEPRECATED column "Use unpackspecColumn instead" #-}
column :: ColumnMaker (IC.Field_ n a) (IC.Field_ n a)
column :: forall (n :: Nullability) a. ColumnMaker (Field_ n a) (Field_ n a)
column = forall (n :: Nullability) a. ColumnMaker (Field_ n a) (Field_ n a)
U.unpackspecField

-- {

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

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

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

--}