git.iko.soy/rel8
on ef28940 help sign in
rel8/src/Rel8/Query/Opaleye.hs
62 lines 1.6 kB history raw
1{-# language TupleSections #-}
3module Rel8.Query.Opaleye
4 ( fromOpaleye
5 , toOpaleye
6 , mapOpaleye
7 , zipOpaleyeWith
8 )
9where
11-- base
12import Control.Applicative ( liftA2 )
13import Prelude
15-- opaleye
16import qualified Opaleye.Internal.QueryArr as Opaleye
18-- rel8
19import {-# SOURCE #-} Rel8.Query ( Query( Query ) )
22fromOpaleye :: Opaleye.Select a -> Query a
23fromOpaleye = Query . pure . fmap pure
26toOpaleye :: Query a -> Opaleye.Select a
27toOpaleye (Query a) = snd <$> a mempty
30mapOpaleye :: (Opaleye.Select a -> Opaleye.Select b) -> Query a -> Query b
31mapOpaleye f (Query a) = Query (fmap (mapping f) a)
34zipOpaleyeWith :: ()
35 => (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c)
36 -> Query a -> Query b -> Query c
37zipOpaleyeWith f (Query a) (Query b) = Query $ liftA2 (zipping f) a b
40mapping :: ()
41 => (Opaleye.Select a -> Opaleye.Select b)
42 -> Opaleye.Select (m, a) -> Opaleye.Select (m, b)
43mapping f q@(Opaleye.QueryArr qa) = Opaleye.QueryArr $ \(_, tag) ->
44 let
45 ((m, _), _, _) = qa ((), tag)
46 Opaleye.QueryArr qa' = (m,) <$> f (snd <$> q)
47 in
48 qa' ((), tag)
51zipping :: Semigroup m
52 => (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c)
53 -> Opaleye.Select (m, a) -> Opaleye.Select (m, b) -> Opaleye.Select (m, c)
54zipping f q@(Opaleye.QueryArr qa) q'@(Opaleye.QueryArr qa') =
55 Opaleye.QueryArr $ \(_, tag) ->
56 let
57 ((m, _), _, _) = qa ((), tag)
58 ((m', _), _, _) = qa' ((), tag)
59 m'' = m <> m'
60 Opaleye.QueryArr qa'' = (m'',) <$> f (snd <$> q) (snd <$> q')
61 in
62 qa'' ((), tag)