{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}

module Opaleye.SQLite.Binary where

import           Opaleye.SQLite.QueryArr (Query)
import qualified Opaleye.SQLite.Internal.QueryArr as Q
import qualified Opaleye.SQLite.Internal.Binary as B
import qualified Opaleye.SQLite.Internal.Tag as T
import qualified Opaleye.SQLite.Internal.PrimQuery as PQ
import qualified Opaleye.SQLite.Internal.PackMap as PM

import           Data.Profunctor.Product.Default (Default, def)

-- | Example type specialization:
--
-- @
-- unionAll :: Query (Column a, Column b)
--          -> Query (Column a, Column b)
--          -> Query (Column a, Column b)
-- @
--
-- Assuming the @makeAdaptorAndInstance@ splice has been run for the product type @Foo@:
--
-- @
-- unionAll :: Query (Foo (Column a) (Column b) (Column c))
--          -> Query (Foo (Column a) (Column b) (Column c))
--          -> Query (Foo (Column a) (Column b) (Column c))
-- @
unionAll :: Default B.Binaryspec columns columns =>
            Query columns -> Query columns -> Query columns
unionAll :: Query columns -> Query columns -> Query columns
unionAll = Binaryspec columns columns
-> Query columns -> Query columns -> Query columns
forall columns columns'.
Binaryspec columns columns'
-> Query columns -> Query columns -> Query columns'
unionAllExplicit Binaryspec columns columns
forall (p :: * -> * -> *) a b. Default p a b => p a b
def

unionAllExplicit :: B.Binaryspec columns columns'
                 -> Query columns -> Query columns -> Query columns'
unionAllExplicit :: Binaryspec columns columns'
-> Query columns -> Query columns -> Query columns'
unionAllExplicit Binaryspec columns columns'
binaryspec Query columns
q1 Query columns
q2 = (((), Tag) -> (columns', PrimQuery, Tag)) -> Query columns'
forall a b. ((a, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
Q.simpleQueryArr ((), Tag) -> (columns', PrimQuery, Tag)
q where
  q :: ((), Tag) -> (columns', PrimQuery, Tag)
q ((), Tag
startTag) = (columns'
newColumns, PrimQuery
newPrimQuery, Tag -> Tag
T.next Tag
endTag)
    where (columns
columns1, PrimQuery
primQuery1, Tag
midTag) = Query columns -> ((), Tag) -> (columns, PrimQuery, Tag)
forall a b. QueryArr a b -> (a, Tag) -> (b, PrimQuery, Tag)
Q.runSimpleQueryArr Query columns
q1 ((), Tag
startTag)
          (columns
columns2, PrimQuery
primQuery2, Tag
endTag) = Query columns -> ((), Tag) -> (columns, PrimQuery, Tag)
forall a b. QueryArr a b -> (a, Tag) -> (b, PrimQuery, Tag)
Q.runSimpleQueryArr Query columns
q2 ((), Tag
midTag)

          (columns'
newColumns, [(Symbol, (PrimExpr, PrimExpr))]
pes) =
            PM [(Symbol, (PrimExpr, PrimExpr))] columns'
-> (columns', [(Symbol, (PrimExpr, PrimExpr))])
forall a r. PM [a] r -> (r, [a])
PM.run (Binaryspec columns columns'
-> ((PrimExpr, PrimExpr)
    -> StateT
         ([(Symbol, (PrimExpr, PrimExpr))], Int) Identity PrimExpr)
-> (columns, columns)
-> PM [(Symbol, (PrimExpr, PrimExpr))] columns'
forall (f :: * -> *) columns columns'.
Applicative f =>
Binaryspec columns columns'
-> ((PrimExpr, PrimExpr) -> f PrimExpr)
-> (columns, columns)
-> f columns'
B.runBinaryspec Binaryspec columns columns'
binaryspec (Tag
-> (PrimExpr, PrimExpr)
-> StateT ([(Symbol, (PrimExpr, PrimExpr))], Int) Identity PrimExpr
B.extractBinaryFields Tag
endTag)
                                    (columns
columns1, columns
columns2))

          newPrimQuery :: PrimQuery
newPrimQuery = BinOp
-> [(Symbol, (PrimExpr, PrimExpr))]
-> (PrimQuery, PrimQuery)
-> PrimQuery
PQ.Binary BinOp
PQ.UnionAll [(Symbol, (PrimExpr, PrimExpr))]
pes (PrimQuery
primQuery1, PrimQuery
primQuery2)