git.iko.soy/rel8
on bf19395 help sign in
rel8/src/Rel8/Table/Name.hs
88 lines 2.7 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, nonEmpty )
21import Data.Maybe ( fromMaybe )
22import Prelude
24-- opaleye
25import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
27-- rel8
28import Rel8.Expr ( Expr, Col( E ) )
29import Rel8.Expr.Opaleye ( toPrimExpr )
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 )
36-- | Construct a table in the 'Name' context containing the names of all
37-- columns. Nested column names will be combined with @/@.
38--
39-- See also: 'namesFromLabelsWith'.
40namesFromLabels :: Table Name a => a
41namesFromLabels = namesFromLabelsWith go
42 where
43 go = fold . intersperse "/"
46-- | Construct a table in the 'Name' context containing the names of all
47-- columns. The supplied function can be used to transform column names.
48--
49-- This function can be used to generically derive the columns for a
50-- 'TableSchema'. For example,
51--
52-- @
53-- myTableSchema :: TableSchema (MyTable Name)
54-- myTableSchema = TableSchema
55-- { columns = namesFromLabelsWith last
56-- }
57-- @
58--
59-- will construct a 'TableSchema' where each columns names exactly corresponds
60-- to the name of the Haskell field.
61namesFromLabelsWith :: Table Name a
62 => (NonEmpty String -> String) -> a
63namesFromLabelsWith f = fromColumns $ htabulate $ \field ->
64 case hfield hspecs field of
65 SSpec {labels} -> N (Name (f (renderLabels labels)))
68showExprs :: Table Expr a => a -> [(String, Opaleye.PrimExpr)]
69showExprs as = case (namesFromLabels, toColumns as) of
70 (names, exprs) -> getConst $ htabulateA $ \field ->
71 case (hfield names field, hfield exprs field) of
72 (N (Name name), E expr) -> Const [(name, toPrimExpr expr)]
75showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]
76showLabels _ = getConst $
77 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
78 SSpec {labels} -> Const [renderLabels labels]
81showNames :: forall a. Table Name a => a -> [String]
82showNames (toColumns -> names) = getConst $
83 htabulateA @(Columns a) $ \field -> case hfield names field of
84 N (Name name) -> Const [name]
87renderLabels :: [String] -> NonEmpty String
88renderLabels labels = fromMaybe (pure "anon") (nonEmpty labels )