git.iko.soy/rel8
on ae4607a 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 Opaleye.QueryArr f -> case 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.QueryArr qa) = Opaleye.QueryArr $ \(_, tag) ->
52 let
53 ((m, _), _, _) = qa ((), tag)
54 Opaleye.QueryArr qa' = (m,) <$> f (snd <$> q)
55 in
56 qa' ((), 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@(Opaleye.QueryArr qa) q'@(Opaleye.QueryArr qa') =
63 Opaleye.QueryArr $ \(_, tag) ->
64 let
65 ((m, _), _, _) = qa ((), tag)
66 ((m', _), _, _) = qa' ((), tag)
67 m'' = m <> m'
68 Opaleye.QueryArr qa'' = (m'',) <$> f (snd <$> q) (snd <$> q')
69 in
70 qa'' ((), tag)