git.iko.soy/rel8
on 97d89cf help sign in
rel8/src/Rel8/Table/Name.hs
93 lines 2.9 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language FlexibleInstances #-}
4{-# language MultiParamTypeClasses #-}
5{-# language NamedFieldPuns #-}
6{-# language ScopedTypeVariables #-}
7{-# language TypeApplications #-}
8{-# language TypeFamilies #-}
9{-# language UndecidableInstances #-}
10{-# language ViewPatterns #-}
12module Rel8.Table.Name
13 ( namesFromLabels
14 , namesFromLabelsWith
15 , showExprs
16 , showLabels
17 , showNames
18 )
19where
21-- base
22import Data.Foldable ( fold )
23import Data.Functor.Const ( Const( Const ), getConst )
24import Data.List.NonEmpty ( NonEmpty, intersperse, nonEmpty )
25import Data.Maybe ( fromMaybe )
26import Prelude
28-- opaleye
29import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
31-- rel8
32import Rel8.Expr ( Expr( E ) )
33import Rel8.Expr.Opaleye ( toPrimExpr )
34import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
35import Rel8.Schema.Name ( Name( N, Name ) )
36import Rel8.Schema.Spec ( SSpec(..) )
37import Rel8.Table ( Table(..) )
38import Rel8.Table.Cols ( Cols( Cols ) )
41-- | Construct a table in the 'Name' context containing the names of all
42-- columns. Nested column names will be combined with @/@.
43--
44-- See also: 'namesFromLabelsWith'.
45namesFromLabels :: Table Name a => a
46namesFromLabels = namesFromLabelsWith go
47 where
48 go = fold . intersperse "/"
51-- | Construct a table in the 'Name' context containing the names of all
52-- columns. The supplied function can be used to transform column names.
53--
54-- This function can be used to generically derive the columns for a
55-- 'TableSchema'. For example,
56--
57-- @
58-- myTableSchema :: TableSchema (MyTable Name)
59-- myTableSchema = TableSchema
60-- { columns = namesFromLabelsWith last
61-- }
62-- @
63--
64-- will construct a 'TableSchema' where each columns names exactly corresponds
65-- to the name of the Haskell field.
66namesFromLabelsWith :: Table Name a
67 => (NonEmpty String -> String) -> a
68namesFromLabelsWith f = fromColumns $ htabulate $ \field ->
69 case hfield hspecs field of
70 SSpec {labels} -> N (Name (f (renderLabels labels)))
73showExprs :: Table Expr a => a -> [(String, Opaleye.PrimExpr)]
74showExprs as = case (namesFromLabels, toColumns as) of
75 (Cols names, exprs) -> getConst $ htabulateA $ \field ->
76 case (hfield names field, hfield exprs field) of
77 (N (Name name), E expr) -> Const [(name, toPrimExpr expr)]
80showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]
81showLabels _ = getConst $
82 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
83 SSpec {labels} -> Const [renderLabels labels]
86showNames :: forall a. Table Name a => a -> [String]
87showNames (toColumns -> names) = getConst $
88 htabulateA @(Columns a) $ \field -> case hfield names field of
89 N (Name name) -> Const [name]
92renderLabels :: [String] -> NonEmpty String
93renderLabels labels = fromMaybe (pure "anon") (nonEmpty labels )