git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Query/Opaleye.hs
70 lines 1.8 kB history raw
1{-# language TupleSections #-}
3module Rel8.Query.Opaleye
4 ( fromOpaleye
5 , toOpaleye
6 , mapOpaleye
7 , zipOpaleyeWith
8 , unsafePeekQuery
9 )
10where
12-- base
13import Control.Applicative ( liftA2 )
14import Prelude
16-- opaleye
17import qualified Opaleye.Internal.QueryArr as Opaleye
18import qualified Opaleye.Internal.Tag as Opaleye
20-- rel8
21import {-# SOURCE #-} Rel8.Query ( Query( Query ) )
24fromOpaleye :: Opaleye.Select a -> Query a
25fromOpaleye = Query . pure . fmap pure
28toOpaleye :: Query a -> Opaleye.Select a
29toOpaleye (Query a) = snd <$> a mempty
32mapOpaleye :: (Opaleye.Select a -> Opaleye.Select b) -> Query a -> Query b
33mapOpaleye f (Query a) = Query (fmap (mapping f) a)
36zipOpaleyeWith :: ()
37 => (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c)
38 -> Query a -> Query b -> Query c
39zipOpaleyeWith f (Query a) (Query b) = Query $ liftA2 (zipping f) a b
42unsafePeekQuery :: Query a -> a
43unsafePeekQuery (Query q) = case q mempty of
44 f -> case Opaleye.runStateQueryArr f () Opaleye.start of
45 ((_, a), _, _) -> a
48mapping :: ()
49 => (Opaleye.Select a -> Opaleye.Select b)
50 -> Opaleye.Select (m, a) -> Opaleye.Select (m, b)
51mapping f q = Opaleye.stateQueryArr $ \_ tag ->
52 let
53 ((m, _), _, _) = Opaleye.runStateQueryArr q () tag
54 q' = (m,) <$> f (snd <$> q)
55 in
56 Opaleye.runStateQueryArr q' () tag
59zipping :: Semigroup m
60 => (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c)
61 -> Opaleye.Select (m, a) -> Opaleye.Select (m, b) -> Opaleye.Select (m, c)
62zipping f q q' =
63 Opaleye.stateQueryArr $ \_ tag ->
64 let
65 ((m, _), _, _) = Opaleye.runStateQueryArr q () tag
66 ((m', _), _, _) = Opaleye.runStateQueryArr q' () tag
67 m'' = m <> m'
68 q'' = (m'',) <$> f (snd <$> q) (snd <$> q')
69 in
70 Opaleye.runStateQueryArr q'' () tag