git.iko.soy/rel8
on 8a680c9 help sign in
rel8/src/Rel8/Table/Name.hs
68 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-- casing
24import Text.Casing ( quietSnake )
26-- opaleye
27import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
29-- rel8
30import Rel8.Expr ( Expr, Col(..) )
31import Rel8.Expr.Opaleye ( toPrimExpr )
32import Rel8.Kind.Labels ( renderLabels )
33import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
34import Rel8.Schema.Name ( Name, Col(..) )
35import Rel8.Schema.Spec ( SSpec(..) )
36import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
39namesFromLabels :: Table Name a => a
40namesFromLabels = namesFromLabelsWith go
41 where
42 go = fold . intersperse "/" . fmap quietSnake
45namesFromLabelsWith :: Table Name a
46 => (NonEmpty String -> String) -> a
47namesFromLabelsWith f = fromColumns $ htabulate $ \field ->
48 case hfield hspecs field of
49 SSpec {labels} -> NameCol (f (renderLabels labels))
52showExprs :: Table Expr a => a -> [(String, Opaleye.PrimExpr)]
53showExprs as = case (namesFromLabels, toColumns as) of
54 (names, exprs) -> getConst $ htabulateA $ \field ->
55 case (hfield names field, hfield exprs field) of
56 (NameCol name, DB expr) -> Const [(name, toPrimExpr expr)]
59showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]
60showLabels _ = getConst $
61 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
62 SSpec {labels} -> Const [renderLabels labels]
65showNames :: forall a. Table Name a => a -> [String]
66showNames (toColumns -> names) = getConst $
67 htabulateA @(Columns a) $ \field -> case hfield names field of
68 NameCol name -> Const [name]