module Opaleye.SQLite.Internal.QueryArr where

import           Prelude hiding (id)

import qualified Opaleye.SQLite.Internal.Unpackspec as U
import qualified Opaleye.SQLite.Internal.Tag as Tag
import           Opaleye.SQLite.Internal.Tag (Tag)
import qualified Opaleye.SQLite.Internal.PrimQuery as PQ

import qualified Opaleye.SQLite.Internal.HaskellDB.PrimQuery as HPQ

import qualified Control.Arrow as Arr
import           Control.Arrow ((&&&), (***), arr)
import qualified Control.Category as C
import           Control.Category ((<<<), id)
import           Control.Applicative (Applicative, pure, (<*>))
import qualified Data.Profunctor as P
import qualified Data.Profunctor.Product as PP

newtype QueryArr a b = QueryArr ((a, PQ.PrimQuery, Tag) -> (b, PQ.PrimQuery, Tag))
type Query = QueryArr ()

simpleQueryArr :: ((a, Tag) -> (b, PQ.PrimQuery, Tag)) -> QueryArr a b
simpleQueryArr :: ((a, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
simpleQueryArr (a, Tag) -> (b, PrimQuery, Tag)
f = ((a, PrimQuery, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
forall a b.
((a, PrimQuery, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
QueryArr (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
g
  where g :: (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
g (a
a0, PrimQuery
primQuery, Tag
t0) = (b
a1, PrimQuery -> PrimQuery -> PrimQuery
PQ.times PrimQuery
primQuery PrimQuery
primQuery', Tag
t1)
          where (b
a1, PrimQuery
primQuery', Tag
t1) = (a, Tag) -> (b, PrimQuery, Tag)
f (a
a0, Tag
t0)

runQueryArr :: QueryArr a b -> (a, PQ.PrimQuery, Tag) -> (b, PQ.PrimQuery, Tag)
runQueryArr :: QueryArr a b -> (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
runQueryArr (QueryArr (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
f) = (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
f

runSimpleQueryArr :: QueryArr a b -> (a, Tag) -> (b, PQ.PrimQuery, Tag)
runSimpleQueryArr :: QueryArr a b -> (a, Tag) -> (b, PrimQuery, Tag)
runSimpleQueryArr QueryArr a b
f (a
a, Tag
t) = QueryArr a b -> (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
forall a b.
QueryArr a b -> (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
runQueryArr QueryArr a b
f (a
a, PrimQuery
PQ.Unit, Tag
t)

runSimpleQueryArrStart :: QueryArr a b -> a -> (b, PQ.PrimQuery, Tag)
runSimpleQueryArrStart :: QueryArr a b -> a -> (b, PrimQuery, Tag)
runSimpleQueryArrStart QueryArr a b
q a
a = QueryArr a b -> (a, Tag) -> (b, PrimQuery, Tag)
forall a b. QueryArr a b -> (a, Tag) -> (b, PrimQuery, Tag)
runSimpleQueryArr QueryArr a b
q (a
a, Tag
Tag.start)

runQueryArrUnpack :: U.Unpackspec a b
                  -> Query a -> ([HPQ.PrimExpr], PQ.PrimQuery, Tag)
runQueryArrUnpack :: Unpackspec a b -> Query a -> ([PrimExpr], PrimQuery, Tag)
runQueryArrUnpack Unpackspec a b
unpackspec Query a
q = ([PrimExpr]
primExprs, PrimQuery
primQ, Tag
endTag)
  where (a
columns, PrimQuery
primQ, Tag
endTag) = Query a -> () -> (a, PrimQuery, Tag)
forall a b. QueryArr a b -> a -> (b, PrimQuery, Tag)
runSimpleQueryArrStart Query a
q ()
        primExprs :: [PrimExpr]
primExprs = Unpackspec a b -> a -> [PrimExpr]
forall s t. Unpackspec s t -> s -> [PrimExpr]
U.collectPEs Unpackspec a b
unpackspec a
columns

first3 :: (a1 -> b) -> (a1, a2, a3) -> (b, a2, a3)
first3 :: (a1 -> b) -> (a1, a2, a3) -> (b, a2, a3)
first3 a1 -> b
f (a1
a1, a2
a2, a3
a3) = (a1 -> b
f a1
a1, a2
a2, a3
a3)

instance C.Category QueryArr where
  id :: QueryArr a a
id = ((a, PrimQuery, Tag) -> (a, PrimQuery, Tag)) -> QueryArr a a
forall a b.
((a, PrimQuery, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
QueryArr (a, PrimQuery, Tag) -> (a, PrimQuery, Tag)
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  QueryArr (b, PrimQuery, Tag) -> (c, PrimQuery, Tag)
f . :: QueryArr b c -> QueryArr a b -> QueryArr a c
. QueryArr (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
g = ((a, PrimQuery, Tag) -> (c, PrimQuery, Tag)) -> QueryArr a c
forall a b.
((a, PrimQuery, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
QueryArr ((b, PrimQuery, Tag) -> (c, PrimQuery, Tag)
f ((b, PrimQuery, Tag) -> (c, PrimQuery, Tag))
-> ((a, PrimQuery, Tag) -> (b, PrimQuery, Tag))
-> (a, PrimQuery, Tag)
-> (c, PrimQuery, Tag)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
g)

instance Arr.Arrow QueryArr where
  arr :: (b -> c) -> QueryArr b c
arr b -> c
f   = ((b, PrimQuery, Tag) -> (c, PrimQuery, Tag)) -> QueryArr b c
forall a b.
((a, PrimQuery, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
QueryArr ((b -> c) -> (b, PrimQuery, Tag) -> (c, PrimQuery, Tag)
forall a1 b a2 a3. (a1 -> b) -> (a1, a2, a3) -> (b, a2, a3)
first3 b -> c
f)
  first :: QueryArr b c -> QueryArr (b, d) (c, d)
first QueryArr b c
f = (((b, d), PrimQuery, Tag) -> ((c, d), PrimQuery, Tag))
-> QueryArr (b, d) (c, d)
forall a b.
((a, PrimQuery, Tag) -> (b, PrimQuery, Tag)) -> QueryArr a b
QueryArr ((b, d), PrimQuery, Tag) -> ((c, d), PrimQuery, Tag)
forall b. ((b, b), PrimQuery, Tag) -> ((c, b), PrimQuery, Tag)
g
    where g :: ((b, b), PrimQuery, Tag) -> ((c, b), PrimQuery, Tag)
g ((b
b, b
d), PrimQuery
primQ, Tag
t0) = ((c
c, b
d), PrimQuery
primQ', Tag
t1)
            where (c
c, PrimQuery
primQ', Tag
t1) = QueryArr b c -> (b, PrimQuery, Tag) -> (c, PrimQuery, Tag)
forall a b.
QueryArr a b -> (a, PrimQuery, Tag) -> (b, PrimQuery, Tag)
runQueryArr QueryArr b c
f (b
b, PrimQuery
primQ, Tag
t0)

instance Functor (QueryArr a) where
  fmap :: (a -> b) -> QueryArr a a -> QueryArr a b
fmap a -> b
f = ((a -> b) -> QueryArr a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f QueryArr a b -> QueryArr a a -> QueryArr a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<<)

instance Applicative (QueryArr a) where
  pure :: a -> QueryArr a a
pure = (a -> a) -> QueryArr a a
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((a -> a) -> QueryArr a a) -> (a -> a -> a) -> a -> QueryArr a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a b. a -> b -> a
const
  QueryArr a (a -> b)
f <*> :: QueryArr a (a -> b) -> QueryArr a a -> QueryArr a b
<*> QueryArr a a
g = ((a -> b, a) -> b) -> QueryArr (a -> b, a) b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (((a -> b) -> a -> b) -> (a -> b, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)) QueryArr (a -> b, a) b -> QueryArr a (a -> b, a) -> QueryArr a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< (QueryArr a (a -> b)
f QueryArr a (a -> b) -> QueryArr a a -> QueryArr a (a -> b, a)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& QueryArr a a
g)

instance P.Profunctor QueryArr where
  dimap :: (a -> b) -> (c -> d) -> QueryArr b c -> QueryArr a d
dimap a -> b
f c -> d
g QueryArr b c
a = (c -> d) -> QueryArr c d
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr c -> d
g QueryArr c d -> QueryArr a c -> QueryArr a d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< QueryArr b c
a QueryArr b c -> QueryArr a b -> QueryArr a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< (a -> b) -> QueryArr a b
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr a -> b
f

instance PP.ProductProfunctor QueryArr where
  empty :: QueryArr () ()
empty = QueryArr () ()
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  ***! :: QueryArr a b -> QueryArr a' b' -> QueryArr (a, a') (b, b')
(***!) = QueryArr a b -> QueryArr a' b' -> QueryArr (a, a') (b, b')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***)