git.iko.soy/rel8
on 28aaa76 help sign in
rel8/src/Rel8/Table/Name.hs
64 lines 1.9 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-- rel8
27import Rel8.Expr ( Expr, Col(..) )
28import Rel8.Kind.Labels ( renderLabels )
29import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
30import Rel8.Schema.Name ( Name, Col(..) )
31import Rel8.Schema.Spec ( SSpec(..) )
32import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
35namesFromLabels :: Table Name a => a
36namesFromLabels = namesFromLabelsWith go
37 where
38 go = fold . intersperse "/" . fmap quietSnake
41namesFromLabelsWith :: Table Name a
42 => (NonEmpty String -> String) -> a
43namesFromLabelsWith f = fromColumns $ htabulate $ \field ->
44 case hfield hspecs field of
45 SSpec {labels} -> NameCol (f (renderLabels labels))
48showExprs :: Table Expr a => a -> [(String, String)]
49showExprs as = case (namesFromLabels, toColumns as) of
50 (names, exprs) -> getConst $ htabulateA $ \field ->
51 case (hfield names field, hfield exprs field) of
52 (NameCol name, DB expr) -> Const [(name, show expr)]
55showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]
56showLabels _ = getConst $
57 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
58 SSpec {labels} -> Const [renderLabels labels]
61showNames :: forall a. Table Name a => a -> [String]
62showNames (toColumns -> names) = getConst $
63 htabulateA @(Columns a) $ \field -> case hfield names field of
64 NameCol name -> Const [name]