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') (***)