{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE Rank2Types #-}

module Opaleye.Internal.Table where

import           Opaleye.Internal.Column (Column(Column), unColumn)
import qualified Opaleye.Internal.Tag as Tag
import qualified Opaleye.Internal.Unpackspec as U
import qualified Opaleye.Internal.PrimQuery as PQ
import qualified Opaleye.Internal.PackMap as PM

import qualified Opaleye.Internal.HaskellDB.PrimQuery as HPQ

import qualified Data.Functor.Identity as I
import           Data.Profunctor (Profunctor, dimap, lmap)
import           Data.Profunctor.Product (ProductProfunctor)
import qualified Data.Profunctor.Product as PP
import qualified Data.List.NonEmpty as NEL
import           Data.Monoid (Monoid, mempty, mappend)
import           Data.Semigroup (Semigroup, (<>))
import           Control.Applicative (Applicative, pure, (<*>), liftA2)
import qualified Control.Arrow as Arr

-- | Define a table as follows, where \"id\", \"color\", \"location\",
-- \"quantity\" and \"radius\" are the table's fields in Postgres and
-- the types are given in the type signature.  The @id@ field is an
-- autoincrementing field (i.e. optional for writes).
--
-- @
-- data Widget a b c d e = Widget { wid      :: a
--                                , color    :: b
--                                , location :: c
--                                , quantity :: d
--                                , radius   :: e }
--
-- \$('Data.Profunctor.Product.TH.makeAdaptorAndInstance' \"pWidget\" ''Widget)
--
-- widgetTable :: Table (Widget (Maybe (Field SqlInt4)) (Field SqlText) (Field SqlText)
--                              (Field SqlInt4) (Field SqlFloat8))
--                      (Widget (Field SqlText) (Field SqlText) (Field SqlText)
--                              (Field SqlInt4) (Field SqlFloat8))
-- widgetTable = table \"widgetTable\"
--                      (pWidget Widget { wid      = tableField \"id\"
--                                      , color    = tableField \"color\"
--                                      , location = tableField \"location\"
--                                      , quantity = tableField \"quantity\"
--                                      , radius   = tableField \"radius\" })
-- @
--
-- The constructors of Table are internal only and will be
-- removed in version 0.8.
data Table writeFields viewFields
  = Table String (TableFields writeFields viewFields)
    -- ^ For unqualified table names. Do not use the constructor.  It
    -- is considered deprecated and will be removed in version 0.8.
  | TableWithSchema String String (TableFields writeFields viewFields)
    -- ^ Schema name, table name, table properties.  Do not use the
    -- constructor.  It is considered deprecated and will be removed
    -- in version 0.8.

tableIdentifier :: Table writeColumns viewColumns -> PQ.TableIdentifier
tableIdentifier :: Table writeColumns viewColumns -> TableIdentifier
tableIdentifier (Table String
t TableFields writeColumns viewColumns
_) = Maybe String -> String -> TableIdentifier
PQ.TableIdentifier Maybe String
forall a. Maybe a
Nothing String
t
tableIdentifier (TableWithSchema String
s String
t TableFields writeColumns viewColumns
_) = Maybe String -> String -> TableIdentifier
PQ.TableIdentifier (String -> Maybe String
forall a. a -> Maybe a
Just String
s) String
t

tableColumns :: Table writeColumns viewColumns -> TableFields writeColumns viewColumns
tableColumns :: Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
tableColumns (Table String
_ TableFields writeColumns viewColumns
p) = TableFields writeColumns viewColumns
p
tableColumns (TableWithSchema String
_ String
_ TableFields writeColumns viewColumns
p) = TableFields writeColumns viewColumns
p

-- | Use 'tableColumns' instead.  Will be deprecated soon.
tableProperties :: Table writeColumns viewColumns -> TableFields writeColumns viewColumns
tableProperties :: Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
tableProperties = Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
tableColumns

data TableFields writeColumns viewColumns = TableFields
   { TableFields writeColumns viewColumns
-> Writer writeColumns viewColumns
tablePropertiesWriter :: Writer writeColumns viewColumns
   , TableFields writeColumns viewColumns -> View viewColumns
tablePropertiesView   :: View viewColumns }

{-# DEPRECATED TableColumns "Use 'TableFields' instead. 'TableColumns' will be removed in  version 0.8." #-}
type TableColumns = TableFields

{-# DEPRECATED TableProperties "Use 'TableFields' instead. 'TableProperties' will be removed in  version 0.8." #-}
type TableProperties = TableFields

tableColumnsWriter :: TableFields writeColumns viewColumns
                   -> Writer writeColumns viewColumns
tableColumnsWriter :: TableFields writeColumns viewColumns
-> Writer writeColumns viewColumns
tableColumnsWriter = TableFields writeColumns viewColumns
-> Writer writeColumns viewColumns
forall writeColumns viewColumns.
TableFields writeColumns viewColumns
-> Writer writeColumns viewColumns
tablePropertiesWriter

tableColumnsView :: TableFields writeColumns viewColumns
                 -> View viewColumns
tableColumnsView :: TableFields writeColumns viewColumns -> View viewColumns
tableColumnsView = TableFields writeColumns viewColumns -> View viewColumns
forall writeColumns viewColumns.
TableFields writeColumns viewColumns -> View viewColumns
tablePropertiesView

{-# DEPRECATED View "Internal only.  Do not use.  'View' will be removed in version 0.8." #-}
newtype View columns = View columns

{-# DEPRECATED Writer "Internal only.  Do not use.  'Writer' will be removed in 0.8." #-}

-- There's no reason the second parameter should exist except that we
-- use ProductProfunctors more than ProductContravariants so it makes
-- things easier if we make it one of the former.
--
-- Writer has become very mysterious.  I really couldn't tell you what
-- it means.  It seems to be saying that a `Writer` tells you how an
-- `f columns` contains a list of `(f HPQ.PrimExpr, String)`, i.e. how
-- it contains each column: a column header and the entries in this
-- column for all the rows.
newtype Writer columns dummy =
  Writer (forall f. Functor f =>
          PM.PackMap (f HPQ.PrimExpr, String) () (f columns) ())

-- | 'requiredTableField' is for fields which are not optional.  You
-- must provide them on writes.
requiredTableField :: String -> TableFields (Column a) (Column a)
requiredTableField :: String -> TableFields (Column a) (Column a)
requiredTableField String
columnName = Writer (Column a) (Column a)
-> View (Column a) -> TableFields (Column a) (Column a)
forall writeColumns viewColumns.
Writer writeColumns viewColumns
-> View viewColumns -> TableFields writeColumns viewColumns
TableFields
  (String -> Writer (Column a) (Column a)
forall a. String -> Writer (Column a) (Column a)
requiredW String
columnName)
  (Column a -> View (Column a)
forall columns. columns -> View columns
View (PrimExpr -> Column a
forall pgType. PrimExpr -> Column pgType
Column (String -> PrimExpr
HPQ.BaseTableAttrExpr String
columnName)))


-- | 'optionalTableField' is for fields that you can omit on writes, such as
--  fields which have defaults or which are SERIAL.
optionalTableField :: String -> TableFields (Maybe (Column a)) (Column a)
optionalTableField :: String -> TableFields (Maybe (Column a)) (Column a)
optionalTableField String
columnName = Writer (Maybe (Column a)) (Column a)
-> View (Column a) -> TableFields (Maybe (Column a)) (Column a)
forall writeColumns viewColumns.
Writer writeColumns viewColumns
-> View viewColumns -> TableFields writeColumns viewColumns
TableFields
  (String -> Writer (Maybe (Column a)) (Column a)
forall a. String -> Writer (Maybe (Column a)) (Column a)
optionalW String
columnName)
  (Column a -> View (Column a)
forall columns. columns -> View columns
View (PrimExpr -> Column a
forall pgType. PrimExpr -> Column pgType
Column (String -> PrimExpr
HPQ.BaseTableAttrExpr String
columnName)))

-- | 'readOnlyTableField' is for fields that you must omit on writes, such as
--  SERIAL fields intended to auto-increment only.
readOnlyTableField :: String -> TableFields () (Column a)
readOnlyTableField :: String -> TableFields () (Column a)
readOnlyTableField = (() -> Maybe (Column a))
-> TableFields (Maybe (Column a)) (Column a)
-> TableFields () (Column a)
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap (Maybe (Column a) -> () -> Maybe (Column a)
forall a b. a -> b -> a
const Maybe (Column a)
forall a. Maybe a
Nothing) (TableFields (Maybe (Column a)) (Column a)
 -> TableFields () (Column a))
-> (String -> TableFields (Maybe (Column a)) (Column a))
-> String
-> TableFields () (Column a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> TableFields (Maybe (Column a)) (Column a)
forall a. String -> TableFields (Maybe (Column a)) (Column a)
optionalTableField

{-# DEPRECATED required  "Use 'requiredTableField' instead.  Will be removed in version 0.8." #-}
required :: String -> TableFields (Column a) (Column a)
required :: String -> TableFields (Column a) (Column a)
required = String -> TableFields (Column a) (Column a)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField

{-# DEPRECATED optional "Use 'optionalTableField' instead.  Will be removed in version 0.8." #-}
optional :: String -> TableFields (Maybe (Column a)) (Column a)
optional :: String -> TableFields (Maybe (Column a)) (Column a)
optional = String -> TableFields (Maybe (Column a)) (Column a)
forall a. String -> TableFields (Maybe (Column a)) (Column a)
optionalTableField

{-# DEPRECATED readOnly "Use 'readOnlyTableField' instead.  Will be removed in version 0.8." #-}
readOnly :: String -> TableFields () (Column a)
readOnly :: String -> TableFields () (Column a)
readOnly = String -> TableFields () (Column a)
forall a. String -> TableFields () (Column a)
readOnlyTableField

{-# DEPRECATED tableColumn "Use 'tableField' instead.  Will be removed in 0.8." #-}

class TableColumn writeType sqlType | writeType -> sqlType where
    tableColumn :: String -> TableFields writeType (Column sqlType)
    tableColumn = String -> TableFields writeType (Column sqlType)
forall writeType sqlType.
TableColumn writeType sqlType =>
String -> TableFields writeType (Column sqlType)
tableField
    -- | Infer either a required ('requiredTableField') or optional
    -- ('optionalTableField') field depending on
    -- the write type.  It's generally more convenient to use this
    -- than 'required' or 'optional' but you do have to provide a type
    -- signature instead.
    tableField  :: String -> TableFields writeType (Column sqlType)

instance TableColumn (Column a) a where
    tableField :: String -> TableFields (Column a) (Column a)
tableField = String -> TableFields (Column a) (Column a)
forall a. String -> TableFields (Column a) (Column a)
requiredTableField

instance TableColumn (Maybe (Column a)) a where
    tableField :: String -> TableFields (Maybe (Column a)) (Column a)
tableField = String -> TableFields (Maybe (Column a)) (Column a)
forall a. String -> TableFields (Maybe (Column a)) (Column a)
optionalTableField

queryTable :: U.Unpackspec viewColumns columns
            -> Table writeColumns viewColumns
            -> Tag.Tag
            -> (columns, PQ.PrimQuery)
queryTable :: Unpackspec viewColumns columns
-> Table writeColumns viewColumns -> Tag -> (columns, PrimQuery)
queryTable Unpackspec viewColumns columns
cm Table writeColumns viewColumns
table Tag
tag = (columns
primExprs, PrimQuery
primQ) where
  View viewColumns
tableCols = TableFields writeColumns viewColumns -> View viewColumns
forall writeColumns viewColumns.
TableFields writeColumns viewColumns -> View viewColumns
tableColumnsView (Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
forall writeColumns viewColumns.
Table writeColumns viewColumns
-> TableFields writeColumns viewColumns
tableColumns Table writeColumns viewColumns
table)
  (columns
primExprs, [(Symbol, PrimExpr)]
projcols) = Unpackspec viewColumns columns
-> Tag -> viewColumns -> (columns, [(Symbol, PrimExpr)])
forall tablecolumns columns.
Unpackspec tablecolumns columns
-> Tag -> tablecolumns -> (columns, [(Symbol, PrimExpr)])
runColumnMaker Unpackspec viewColumns columns
cm Tag
tag viewColumns
tableCols
  primQ :: PQ.PrimQuery
  primQ :: PrimQuery
primQ = TableIdentifier -> [(Symbol, PrimExpr)] -> PrimQuery
forall a. TableIdentifier -> [(Symbol, PrimExpr)] -> PrimQuery' a
PQ.BaseTable (Table writeColumns viewColumns -> TableIdentifier
forall writeColumns viewColumns.
Table writeColumns viewColumns -> TableIdentifier
tableIdentifier Table writeColumns viewColumns
table) [(Symbol, PrimExpr)]
projcols

runColumnMaker :: U.Unpackspec tablecolumns columns
                  -> Tag.Tag
                  -> tablecolumns
                  -> (columns, [(HPQ.Symbol, HPQ.PrimExpr)])
runColumnMaker :: Unpackspec tablecolumns columns
-> Tag -> tablecolumns -> (columns, [(Symbol, PrimExpr)])
runColumnMaker Unpackspec tablecolumns columns
cm Tag
tag tablecolumns
tableCols = PM [(Symbol, PrimExpr)] columns -> (columns, [(Symbol, PrimExpr)])
forall a r. PM [a] r -> (r, [a])
PM.run (Unpackspec tablecolumns columns
-> (PrimExpr
    -> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr)
-> tablecolumns
-> PM [(Symbol, PrimExpr)] columns
forall (f :: * -> *) columns b.
Applicative f =>
Unpackspec columns b -> (PrimExpr -> f PrimExpr) -> columns -> f b
U.runUnpackspec Unpackspec tablecolumns columns
cm PrimExpr -> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr
f tablecolumns
tableCols) where
  f :: PrimExpr -> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr
f = (PrimExpr -> String -> String)
-> Tag
-> PrimExpr
-> StateT ([(Symbol, PrimExpr)], Int) Identity PrimExpr
forall primExpr.
(primExpr -> String -> String)
-> Tag -> primExpr -> PM [(Symbol, primExpr)] PrimExpr
PM.extractAttrPE PrimExpr -> String -> String
mkName Tag
tag
  -- The non-AttrExpr PrimExprs are not created by 'makeView' or a
  -- 'ViewColumnMaker' so could only arise from an fmap (if we
  -- implemented a Functor instance) or a direct manipulation of the
  -- tablecols contained in the View (which would be naughty)
  mkName :: PrimExpr -> String -> String
mkName PrimExpr
pe String
i = (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ case PrimExpr
pe of
    HPQ.BaseTableAttrExpr String
columnName -> String
columnName
    HPQ.CompositeExpr PrimExpr
columnExpr String
fieldName -> PrimExpr -> String -> String
mkName PrimExpr
columnExpr String
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fieldName
    PrimExpr
_ -> String
"tablecolumn"

runWriter :: Writer columns columns' -> columns -> [(HPQ.PrimExpr, String)]
runWriter :: Writer columns columns' -> columns -> [(PrimExpr, String)]
runWriter (Writer (PM.PackMap f)) columns
columns = [(PrimExpr, String)]
outColumns
  where ([(PrimExpr, String)]
outColumns, ()) = ((Identity PrimExpr, String) -> ([(PrimExpr, String)], ()))
-> Identity columns -> ([(PrimExpr, String)], ())
forall (f :: * -> *).
Applicative f =>
((Identity PrimExpr, String) -> f ()) -> Identity columns -> f ()
f (Identity PrimExpr, String) -> ([(PrimExpr, String)], ())
forall a b. (Identity a, b) -> ([(a, b)], ())
extract (columns -> Identity columns
forall a. a -> Identity a
I.Identity columns
columns)
        extract :: (Identity a, b) -> ([(a, b)], ())
extract (Identity a
pes, b
s) = ([(Identity a -> a
forall a. Identity a -> a
I.runIdentity Identity a
pes, b
s)], ())

-- This works more generally for any "zippable", that is an
-- Applicative that satisfies
--
--    x == (,) <$> fmap fst x <*> fmap snd x
--
-- However, I'm unaware of a typeclass for this.
runWriter' :: Writer columns columns' -> NEL.NonEmpty columns -> (NEL.NonEmpty [HPQ.PrimExpr], [String])
runWriter' :: Writer columns columns'
-> NonEmpty columns -> (NonEmpty [PrimExpr], [String])
runWriter' (Writer (PM.PackMap f)) NonEmpty columns
columns = (Zip PrimExpr -> NonEmpty [PrimExpr])
-> (Zip PrimExpr, [String]) -> (NonEmpty [PrimExpr], [String])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arr.first Zip PrimExpr -> NonEmpty [PrimExpr]
forall a. Zip a -> NonEmpty [a]
unZip (Zip PrimExpr, [String])
outColumns
  where ((Zip PrimExpr, [String])
outColumns, ()) = ((NonEmpty PrimExpr, String) -> ((Zip PrimExpr, [String]), ()))
-> NonEmpty columns -> ((Zip PrimExpr, [String]), ())
forall (f :: * -> *).
Applicative f =>
((NonEmpty PrimExpr, String) -> f ()) -> NonEmpty columns -> f ()
f (NonEmpty PrimExpr, String) -> ((Zip PrimExpr, [String]), ())
forall a a. (NonEmpty a, a) -> ((Zip a, [a]), ())
extract NonEmpty columns
columns
        extract :: (NonEmpty a, a) -> ((Zip a, [a]), ())
extract (NonEmpty a
pes, a
s) = ((NonEmpty [a] -> Zip a
forall a. NonEmpty [a] -> Zip a
Zip ((a -> [a]) -> NonEmpty a -> NonEmpty [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return NonEmpty a
pes), [a
s]), ())

newtype Zip a = Zip { Zip a -> NonEmpty [a]
unZip :: NEL.NonEmpty [a] }

instance Semigroup (Zip a) where
  Zip NonEmpty [a]
xs <> :: Zip a -> Zip a -> Zip a
<> Zip NonEmpty [a]
ys = NonEmpty [a] -> Zip a
forall a. NonEmpty [a] -> Zip a
Zip (([a] -> [a] -> [a]) -> NonEmpty [a] -> NonEmpty [a] -> NonEmpty [a]
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NEL.zipWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) NonEmpty [a]
xs NonEmpty [a]
ys)

instance Monoid (Zip a) where
  mempty :: Zip a
mempty = NonEmpty [a] -> Zip a
forall a. NonEmpty [a] -> Zip a
Zip NonEmpty [a]
forall a. NonEmpty [a]
mempty'
    where mempty' :: NonEmpty [a]
mempty' = [] [a] -> NonEmpty [a] -> NonEmpty [a]
forall a. a -> NonEmpty a -> NonEmpty a
`NEL.cons` NonEmpty [a]
mempty'
  mappend :: Zip a -> Zip a -> Zip a
mappend = Zip a -> Zip a -> Zip a
forall a. Semigroup a => a -> a -> a
(<>)

requiredW :: String -> Writer (Column a) (Column a)
requiredW :: String -> Writer (Column a) (Column a)
requiredW String
columnName =
  (forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f (Column a)) ())
-> Writer (Column a) (Column a)
forall columns dummy.
(forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f columns) ())
-> Writer columns dummy
Writer ((f (Column a) -> (f PrimExpr, String))
-> (() -> ()) -> PackMap (f PrimExpr, String) () (f (Column a)) ()
forall s a b t. (s -> a) -> (b -> t) -> PackMap a b s t
PM.iso ((f PrimExpr -> String -> (f PrimExpr, String))
-> String -> f PrimExpr -> (f PrimExpr, String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) String
columnName (f PrimExpr -> (f PrimExpr, String))
-> (f (Column a) -> f PrimExpr)
-> f (Column a)
-> (f PrimExpr, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column a -> PrimExpr) -> f (Column a) -> f PrimExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Column a -> PrimExpr
forall a. Column a -> PrimExpr
unColumn) () -> ()
forall a. a -> a
id)

optionalW :: String -> Writer (Maybe (Column a)) (Column a)
optionalW :: String -> Writer (Maybe (Column a)) (Column a)
optionalW String
columnName =
  (forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f (Maybe (Column a))) ())
-> Writer (Maybe (Column a)) (Column a)
forall columns dummy.
(forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f columns) ())
-> Writer columns dummy
Writer ((f (Maybe (Column a)) -> (f PrimExpr, String))
-> (() -> ())
-> PackMap (f PrimExpr, String) () (f (Maybe (Column a))) ()
forall s a b t. (s -> a) -> (b -> t) -> PackMap a b s t
PM.iso ((f PrimExpr -> String -> (f PrimExpr, String))
-> String -> f PrimExpr -> (f PrimExpr, String)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) String
columnName (f PrimExpr -> (f PrimExpr, String))
-> (f (Maybe (Column a)) -> f PrimExpr)
-> f (Maybe (Column a))
-> (f PrimExpr, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Column a) -> PrimExpr)
-> f (Maybe (Column a)) -> f PrimExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Column a) -> PrimExpr
forall a. Maybe (Column a) -> PrimExpr
maybeUnColumn) () -> ()
forall a. a -> a
id)
  where maybeUnColumn :: Maybe (Column a) -> PrimExpr
maybeUnColumn = PrimExpr -> (Column a -> PrimExpr) -> Maybe (Column a) -> PrimExpr
forall b a. b -> (a -> b) -> Maybe a -> b
maybe PrimExpr
HPQ.DefaultInsertExpr Column a -> PrimExpr
forall a. Column a -> PrimExpr
unColumn

-- {

-- Boilerplate instance definitions

instance Functor (Writer a) where
  fmap :: (a -> b) -> Writer a a -> Writer a b
fmap a -> b
_ (Writer forall (f :: * -> *).
Functor f =>
PackMap (f PrimExpr, String) () (f a) ()
g) = (forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f a) ())
-> Writer a b
forall columns dummy.
(forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f columns) ())
-> Writer columns dummy
Writer forall (f :: * -> *).
Functor f =>
PackMap (f PrimExpr, String) () (f a) ()
g

instance Applicative (Writer a) where
  pure :: a -> Writer a a
pure a
_ = (forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f a) ())
-> Writer a a
forall columns dummy.
(forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f columns) ())
-> Writer columns dummy
Writer (() -> PackMap (f PrimExpr, String) () (f a) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  Writer forall (f :: * -> *).
Functor f =>
PackMap (f PrimExpr, String) () (f a) ()
f <*> :: Writer a (a -> b) -> Writer a a -> Writer a b
<*> Writer forall (f :: * -> *).
Functor f =>
PackMap (f PrimExpr, String) () (f a) ()
x = (forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f a) ())
-> Writer a b
forall columns dummy.
(forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f columns) ())
-> Writer columns dummy
Writer ((() -> () -> ())
-> PackMap (f PrimExpr, String) () (f a) ()
-> PackMap (f PrimExpr, String) () (f a) ()
-> PackMap (f PrimExpr, String) () (f a) ()
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\()
_ ()
_ -> ()) PackMap (f PrimExpr, String) () (f a) ()
forall (f :: * -> *).
Functor f =>
PackMap (f PrimExpr, String) () (f a) ()
f PackMap (f PrimExpr, String) () (f a) ()
forall (f :: * -> *).
Functor f =>
PackMap (f PrimExpr, String) () (f a) ()
x)

instance Profunctor Writer where
  dimap :: (a -> b) -> (c -> d) -> Writer b c -> Writer a d
dimap a -> b
f c -> d
_ (Writer forall (f :: * -> *).
Functor f =>
PackMap (f PrimExpr, String) () (f b) ()
h) = (forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f a) ())
-> Writer a d
forall columns dummy.
(forall (f :: * -> *).
 Functor f =>
 PackMap (f PrimExpr, String) () (f columns) ())
-> Writer columns dummy
Writer ((f a -> f b)
-> PackMap (f PrimExpr, String) () (f b) ()
-> PackMap (f PrimExpr, String) () (f a) ()
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) PackMap (f PrimExpr, String) () (f b) ()
forall (f :: * -> *).
Functor f =>
PackMap (f PrimExpr, String) () (f b) ()
h)

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

instance Functor (TableFields a) where
  fmap :: (a -> b) -> TableFields a a -> TableFields a b
fmap a -> b
f (TableFields Writer a a
w (View a
v)) = Writer a b -> View b -> TableFields a b
forall writeColumns viewColumns.
Writer writeColumns viewColumns
-> View viewColumns -> TableFields writeColumns viewColumns
TableFields ((a -> b) -> Writer a a -> Writer a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Writer a a
w) (b -> View b
forall columns. columns -> View columns
View (a -> b
f a
v))

instance Applicative (TableFields a) where
  pure :: a -> TableFields a a
pure a
x = Writer a a -> View a -> TableFields a a
forall writeColumns viewColumns.
Writer writeColumns viewColumns
-> View viewColumns -> TableFields writeColumns viewColumns
TableFields (a -> Writer a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x) (a -> View a
forall columns. columns -> View columns
View a
x)
  TableFields Writer a (a -> b)
fw (View a -> b
fv) <*> :: TableFields a (a -> b) -> TableFields a a -> TableFields a b
<*> TableFields Writer a a
xw (View a
xv) =
    Writer a b -> View b -> TableFields a b
forall writeColumns viewColumns.
Writer writeColumns viewColumns
-> View viewColumns -> TableFields writeColumns viewColumns
TableFields (Writer a (a -> b)
fw Writer a (a -> b) -> Writer a a -> Writer a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Writer a a
xw) (b -> View b
forall columns. columns -> View columns
View (a -> b
fv a
xv))

instance Profunctor TableFields where
  dimap :: (a -> b) -> (c -> d) -> TableFields b c -> TableFields a d
dimap a -> b
f c -> d
g (TableFields Writer b c
w (View c
v)) = Writer a d -> View d -> TableFields a d
forall writeColumns viewColumns.
Writer writeColumns viewColumns
-> View viewColumns -> TableFields writeColumns viewColumns
TableFields ((a -> b) -> (c -> d) -> Writer b c -> Writer 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 Writer b c
w)
                                                            (d -> View d
forall columns. columns -> View columns
View (c -> d
g c
v))
instance ProductProfunctor TableFields where
  purePP :: b -> TableFields a b
purePP = b -> TableFields a b
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  **** :: TableFields a (b -> c) -> TableFields a b -> TableFields a c
(****) = TableFields a (b -> c) -> TableFields a b -> TableFields a c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

instance Functor (Table a) where
  fmap :: (a -> b) -> Table a a -> Table a b
fmap a -> b
f (Table String
t TableFields a a
tp) = String -> TableFields a b -> Table a b
forall writeFields viewFields.
String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Table String
t ((a -> b) -> TableFields a a -> TableFields a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TableFields a a
tp)
  fmap a -> b
f (TableWithSchema String
s String
t TableFields a a
tp) = String -> String -> TableFields a b -> Table a b
forall writeFields viewFields.
String
-> String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
TableWithSchema String
s String
t ((a -> b) -> TableFields a a -> TableFields a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TableFields a a
tp)

instance Profunctor Table where
  dimap :: (a -> b) -> (c -> d) -> Table b c -> Table a d
dimap a -> b
f c -> d
g (Table String
t TableFields b c
tp) = String -> TableFields a d -> Table a d
forall writeFields viewFields.
String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
Table String
t ((a -> b) -> (c -> d) -> TableFields b c -> TableFields 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 TableFields b c
tp)
  dimap a -> b
f c -> d
g (TableWithSchema String
s String
t TableFields b c
tp) = String -> String -> TableFields a d -> Table a d
forall writeFields viewFields.
String
-> String
-> TableFields writeFields viewFields
-> Table writeFields viewFields
TableWithSchema String
s String
t ((a -> b) -> (c -> d) -> TableFields b c -> TableFields 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 TableFields b c
tp)

-- }