git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Schema/Result.hs
75 lines 2.0 kB history raw
1{-# language DataKinds #-}
2{-# language GADTs #-}
3{-# language NamedFieldPuns #-}
4{-# language StandaloneKindSignatures #-}
5{-# language TypeFamilies #-}
7module Rel8.Schema.Result
8 ( Col( Result ), Result
9 , relabel
10 , null, nullifier, unnullifier
11 , vectorizer, unvectorizer
12 )
13where
15-- base
16import Prelude hiding ( null )
18-- rel8
19import Rel8.Schema.Context ( Interpretation( Col ) )
20import Rel8.Schema.HTable.Identity ( HIdentity(..) )
21import Rel8.Schema.Kind ( Context )
22import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )
23import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
26type Result :: Context
27data Result a
30instance Interpretation Result where
31 data Col Result _spec where
32 Result :: a -> Col Result ('Spec labels necessity a)
35relabel :: ()
36 => HIdentity ('Spec labels necessity a) (Col Result)
37 -> HIdentity ('Spec relabels necessity a) (Col Result)
38relabel (HIdentity (Result a)) = HIdentity (Result a)
41null :: Col Result ('Spec labels necessity (Maybe a))
42null = Result Nothing
45nullifier :: ()
46 => SSpec ('Spec labels necessity a)
47 -> Col Result ('Spec labels necessity a)
48 -> Col Result ('Spec labels necessity (Nullify a))
49nullifier SSpec {nullity} (Result a) = Result $ case nullity of
50 Null -> a
51 NotNull -> Just a
54unnullifier :: ()
55 => SSpec ('Spec labels necessity a)
56 -> Col Result ('Spec labels necessity (Nullify a))
57 -> Maybe (Col Result ('Spec labels necessity a))
58unnullifier SSpec {nullity} (Result a) =
59 case nullity of
60 Null -> pure $ Result a
61 NotNull -> Result <$> a
64vectorizer :: Functor f
65 => SSpec ('Spec labels necessity a)
66 -> f (Col Result ('Spec labels necessity a))
67 -> Col Result ('Spec labels necessity (f a))
68vectorizer _ = Result . fmap (\(Result a) -> a)
71unvectorizer :: Functor f
72 => SSpec ('Spec labels necessity a)
73 -> Col Result ('Spec labels necessity (f a))
74 -> f (Col Result ('Spec labels necessity a))
75unvectorizer _ (Result results) = Result <$> results