git.iko.soy/rel8
on b86f445 help sign in
rel8/src/Rel8/Table/Name.hs
65 lines 2.0 kB history raw
1{-# language FlexibleContexts #-}
2{-# language NamedFieldPuns #-}
3{-# language ScopedTypeVariables #-}
4{-# language TypeApplications #-}
5{-# language TypeFamilies #-}
6{-# language ViewPatterns #-}
8module Rel8.Table.Name
9 ( namesFromLabels
10 , namesFromLabelsWith
11 , showExprs
12 , showLabels
13 , showNames
14 )
15where
17-- base
18import Data.Foldable ( fold )
19import Data.Functor.Const ( Const( Const ), getConst )
20import Data.List.NonEmpty ( NonEmpty, intersperse )
21import Prelude
23-- opaleye
24import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
26-- rel8
27import Rel8.Expr ( Expr, Col( E ) )
28import Rel8.Expr.Opaleye ( toPrimExpr )
29import Rel8.Kind.Labels ( renderLabels )
30import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
31import Rel8.Schema.Name ( Name( Name ), Col( N ) )
32import Rel8.Schema.Spec ( SSpec(..) )
33import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
36namesFromLabels :: Table Name a => a
37namesFromLabels = namesFromLabelsWith go
38 where
39 go = fold . intersperse "/"
42namesFromLabelsWith :: Table Name a
43 => (NonEmpty String -> String) -> a
44namesFromLabelsWith f = fromColumns $ htabulate $ \field ->
45 case hfield hspecs field of
46 SSpec {labels} -> N (Name (f (renderLabels labels)))
49showExprs :: Table Expr a => a -> [(String, Opaleye.PrimExpr)]
50showExprs as = case (namesFromLabels, toColumns as) of
51 (names, exprs) -> getConst $ htabulateA $ \field ->
52 case (hfield names field, hfield exprs field) of
53 (N (Name name), E expr) -> Const [(name, toPrimExpr expr)]
56showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]
57showLabels _ = getConst $
58 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
59 SSpec {labels} -> Const [renderLabels labels]
62showNames :: forall a. Table Name a => a -> [String]
63showNames (toColumns -> names) = getConst $
64 htabulateA @(Columns a) $ \field -> case hfield names field of
65 N (Name name) -> Const [name]