git.iko.soy/rel8
on 0272bcc help sign in
rel8/src/Rel8/Table/Name.hs
79 lines 2.4 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 , showLabels
16 , showNames
17 )
18where
20-- base
21import Data.Foldable ( fold )
22import Data.Functor.Const ( Const( Const ), getConst )
23import Data.List.NonEmpty ( NonEmpty, intersperse, nonEmpty )
24import Data.Maybe ( fromMaybe )
25import Prelude
27-- rel8
28import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
29import Rel8.Schema.Name ( Name( Name ) )
30import Rel8.Schema.Spec ( Spec(..) )
31import Rel8.Table ( Table(..) )
34-- | Construct a table in the 'Name' context containing the names of all
35-- columns. Nested column names will be combined with @/@.
36--
37-- See also: 'namesFromLabelsWith'.
38namesFromLabels :: Table Name a => a
39namesFromLabels = namesFromLabelsWith go
40 where
41 go = fold . intersperse "/"
44-- | Construct a table in the 'Name' context containing the names of all
45-- columns. The supplied function can be used to transform column names.
46--
47-- This function can be used to generically derive the columns for a
48-- 'TableSchema'. For example,
49--
50-- @
51-- myTableSchema :: TableSchema (MyTable Name)
52-- myTableSchema = TableSchema
53-- { columns = namesFromLabelsWith last
54-- }
55-- @
56--
57-- will construct a 'TableSchema' where each columns names exactly corresponds
58-- to the name of the Haskell field.
59namesFromLabelsWith :: Table Name a
60 => (NonEmpty String -> String) -> a
61namesFromLabelsWith f = fromColumns $ htabulate $ \field ->
62 case hfield hspecs field of
63 Spec {labels} -> Name (f (renderLabels labels))
66showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]
67showLabels _ = getConst $
68 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
69 Spec {labels} -> Const (pure (renderLabels labels))
72showNames :: forall a. Table Name a => a -> NonEmpty String
73showNames (toColumns -> names) = getConst $
74 htabulateA @(Columns a) $ \field -> case hfield names field of
75 Name name -> Const (pure name)
78renderLabels :: [String] -> NonEmpty String
79renderLabels labels = fromMaybe (pure "anon") (nonEmpty labels )