git.iko.soy/typeable/postgresql-simple
on ee417bd help sign in
typeable/postgresql-simple/tools/GenTypeInfo.hs
251 lines 7.5 kB history raw
1------------------------------------------------------------------------------
2-- |
3-- Module: GenTypeInfo
4-- Copyright: (c) 2011-2012 Leon P Smith
5-- License: BSD3
6-- Maintainer: Leon P Smith <leon@melding-monads.com>
7-- Stability: experimental
8--
9-- Queries a PostgreSQL database for the Object IDs and other type
10-- information associated with typenames, and generates a module with
11-- data constants representing part of the pg_type table.
12--
13-- Note that only some of the built-in types have stable type OIDs, and
14-- thus a TypeInfo module that contains user-defined types is liable to
15-- not work across different database instances. For these types, it is
16-- better for `FromField` to use the `typeinfo` operator that works for
17-- any type, whether or not it is in this module.
18--
19-- `typeinfo` works because postgresql-simple will dynamically query
20-- the pg_types table the first time it receives a type OID it doesn't
21-- know about. It then constructs a TypeInfo record and stores it in
22-- a per-connection cache for later use.
23--
24------------------------------------------------------------------------------
26{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}
28module GenBuiltinTypes where
30import Prelude hiding ((++), concat)
32import StringsQQ
33import Control.Arrow((&&&))
34import Control.Applicative
35import Control.Exception(bracket)
36import Database.PostgreSQL.Simple
37import Database.PostgreSQL.Simple.FromRow
38import Database.PostgreSQL.Simple.Ok
39import Database.PostgreSQL.Simple.Types(Oid(..))
40import Database.PostgreSQL.Simple.SqlQQ
41import qualified Data.ByteString.Char8 as B
42import Data.ByteString(ByteString)
43import qualified Data.ByteString.Lazy as L
44import qualified Blaze.ByteString.Builder as Blaze
45import qualified Blaze.ByteString.Builder.ByteString as Blaze
46import qualified Blaze.ByteString.Builder.Char8 as Blaze
47import Data.String
48import Data.List ( sort, intersperse )
49import qualified Data.Map as Map
51import Data.Monoid
53(++) :: Monoid a => a -> a -> a
54(++) = mappend
55infixr 5 ++
57concat :: Monoid a => [a] -> a
58concat = mconcat
60data TypeInfo = TypeInfo
61 { typoid :: Oid
62 , typcategory :: Char
63 , typdelim :: Char
64 , typname :: ByteString
65 , typelem :: Oid
66 }
68instance FromRow TypeInfo where
69 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field
71type NameMap = Map.Map B.ByteString TypeInfo
73type OidMap = Map.Map Oid TypeInfo
75type TypeName = (B.ByteString, B.ByteString)
77type TypeNames = [TypeName]
79-- Note that the following syntax is "pgName <whitespace> hsName", though
80-- they default to the same thing if there is only one identifier
81typeNames :: TypeNames
82typeNames = [typenames|
83bool
84bytea
85char
86name
87int8
88int2
89int4
90regproc
91text
92oid
93tid
94xid
95cid
96xml
97point
98lseg
99path
100box
101polygon
102line
103cidr
104float4
105float8
106abstime
107reltime
108tinterval
109unknown
110circle
111money
112macaddr
113inet
114bpchar
115varchar
116date
117time
118timestamp
119timestamptz
120interval
121timetz
122bit
123varbit
124numeric
125refcursor
126record
127void
128uuid
129json
130jsonb
131|]
133instance IsString Blaze.Builder where
134 fromString = Blaze.fromByteString . fromString
136connectionString = "dbname=postgres"
138withPostgreSQL = bracket (connectPostgreSQL connectionString) close
140getTypeInfos :: TypeNames -> IO (OidMap, NameMap)
141getTypeInfos typnames = withPostgreSQL $ \conn -> do
142 infos <- query conn [sql|
143 SELECT oid, typcategory, typdelim, typname, typelem
144 FROM pg_type
145 WHERE typname IN ?
146 |]
147 (Only (In (sort (map pg typnames))))
148 loop conn (oidMap infos) (nameMap infos) infos
149 where
150 oidMap = Map.fromList . map (typoid &&& id)
151 nameMap = Map.fromList . map (typname &&& id)
152 loop conn oids names infos = do
153 let unknowns = [ x | x <- map typelem infos,
154 x /= Oid 0,
155 not (Map.member x oids) ]
156 case unknowns of
157 [] -> return (oids, names)
158 (_:_) -> do
159 infos' <- query conn [sql|
160 SELECT oid, typcategory, typdelim, typname, typelem
161 FROM pg_type
162 WHERE oid IN ?
163 |] (Only (In (sort unknowns)))
164 let oids' = oids `Map.union` oidMap infos'
165 names' = names `Map.union` nameMap infos'
166 loop conn oids' names' infos'
168main = do
169 (oidmap, namemap) <- getTypeInfos typeNames
170 L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"
171 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))
174showOid (Oid n) = show n
176renderOid :: NameMap -> TypeName -> Blaze.Builder
177renderOid byName name
178 = case Map.lookup (pg name) byName of
179 Nothing -> error (B.unpack (pg name))
180 Just (showOid . typoid -> n) -> fromString n
181 ++ fromString (replicate (4 - length n) ' ')
183renderElem :: OidMap -> Oid -> Blaze.Builder
184renderElem byOid elemOid
185 | elemOid == Oid 0 = "Nothing"
186 | otherwise = case Map.lookup elemOid byOid of
187 Nothing -> error ("oid not found: " ++ show elemOid)
188 Just x -> "Just " ++ bs (typname x)
190-- FIXME: add in any names that we need that we didn't specify, (i.e.
191-- the "unknowns" in getTypeInfos
192-- and munge them into a valid haskell identifier if needed.
193getNames :: NameMap -> TypeNames -> TypeNames
194getNames _ x = x
196bs = Blaze.fromByteString
198pg = fst
200hs = snd
202renderFile :: OidMap -> NameMap -> TypeNames -> Blaze.Builder
203renderFile byOid byName names = ([longstring|
204------------------------------------------------------------------------------
205-- |
206-- Module: Database.PostgreSQL.Simple.TypeInfo
207-- Copyright: (c) 2011-2012 Leon P Smith
208-- License: BSD3
209-- Maintainer: Leon P Smith <leon@melding-monads.com>
210-- Stability: experimental
211--
212-- This module contains portions of the @pg_type@ table that are relevant
213-- to postgresql-simple and are believed to not change between PostgreSQL
214-- versions.
215--
216------------------------------------------------------------------------------
218-- Note that this file is generated by tools/GenTypeInfo.hs, and should
219-- not be edited directly
221module Database.PostgreSQL.Simple.TypeInfo.Static
222 ( TypeInfo(..)
223 , staticTypeInfo
224|] ++ concat [ " , " ++ bs (hs name) ++ "\n"
225 | name <- names ] ++ [longstring|
226 ) where
228import Database.PostgreSQL.LibPQ (Oid(..))
229import Database.PostgreSQL.Simple.TypeInfo.Types
231staticTypeInfo :: Oid -> Maybe TypeInfo
232staticTypeInfo (Oid x) = case x of
233|] ++ concat [concat [ " ", renderOid byName name,
234 " -> Just ", bs (hs name), "\n"
235 ]
236 | name <- names ]
237 ++ [longstring|
238 _ -> Nothing
239|]
240 ++ concat [concat
241 [ "\n"
242 , bs (hs name), " :: TypeInfo\n"
243 , bs (hs name), " = Basic {\n"
244 , " typoid = ", fromString (show typoid), ",\n"
245 , " typcategory = '", Blaze.fromChar typcategory, "',\n"
246 , " typdelim = '", Blaze.fromChar typdelim, "',\n"
247 , " typname = \"", bs typname, "\"\n"
248 , " }\n"
249 ]
250 | name <- getNames byName names
251 , let (Just (TypeInfo{..})) = Map.lookup (pg name) byName])