git.iko.soy/typeable/postgresql-simple
on cb552f9 help sign in
typeable/postgresql-simple/tools/GenTypeInfo.hs
250 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
130|]
132instance IsString Blaze.Builder where
133 fromString = Blaze.fromByteString . fromString
135connectionString = "dbname=postgres"
137withPostgreSQL = bracket (connectPostgreSQL connectionString) close
139getTypeInfos :: TypeNames -> IO (OidMap, NameMap)
140getTypeInfos typnames = withPostgreSQL $ \conn -> do
141 infos <- query conn [sql|
142 SELECT oid, typcategory, typdelim, typname, typelem
143 FROM pg_type
144 WHERE typname IN ?
145 |]
146 (Only (In (sort (map pg typnames))))
147 loop conn (oidMap infos) (nameMap infos) infos
148 where
149 oidMap = Map.fromList . map (typoid &&& id)
150 nameMap = Map.fromList . map (typname &&& id)
151 loop conn oids names infos = do
152 let unknowns = [ x | x <- map typelem infos,
153 x /= Oid 0,
154 not (Map.member x oids) ]
155 case unknowns of
156 [] -> return (oids, names)
157 (_:_) -> do
158 infos' <- query conn [sql|
159 SELECT oid, typcategory, typdelim, typname, typelem
160 FROM pg_type
161 WHERE oid IN ?
162 |] (Only (In (sort unknowns)))
163 let oids' = oids `Map.union` oidMap infos'
164 names' = names `Map.union` nameMap infos'
165 loop conn oids' names' infos'
167main = do
168 (oidmap, namemap) <- getTypeInfos typeNames
169 L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"
170 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))
173showOid (Oid n) = show n
175renderOid :: NameMap -> TypeName -> Blaze.Builder
176renderOid byName name
177 = case Map.lookup (pg name) byName of
178 Nothing -> error (B.unpack (pg name))
179 Just (showOid . typoid -> n) -> fromString n
180 ++ fromString (replicate (4 - length n) ' ')
182renderElem :: OidMap -> Oid -> Blaze.Builder
183renderElem byOid elemOid
184 | elemOid == Oid 0 = "Nothing"
185 | otherwise = case Map.lookup elemOid byOid of
186 Nothing -> error ("oid not found: " ++ show elemOid)
187 Just x -> "Just " ++ bs (typname x)
189-- FIXME: add in any names that we need that we didn't specify, (i.e.
190-- the "unknowns" in getTypeInfos
191-- and munge them into a valid haskell identifier if needed.
192getNames :: NameMap -> TypeNames -> TypeNames
193getNames _ x = x
195bs = Blaze.fromByteString
197pg = fst
199hs = snd
201renderFile :: OidMap -> NameMap -> TypeNames -> Blaze.Builder
202renderFile byOid byName names = ([longstring|
203------------------------------------------------------------------------------
204-- |
205-- Module: Database.PostgreSQL.Simple.TypeInfo
206-- Copyright: (c) 2011-2012 Leon P Smith
207-- License: BSD3
208-- Maintainer: Leon P Smith <leon@melding-monads.com>
209-- Stability: experimental
210--
211-- This module contains portions of the @pg_type@ table that are relevant
212-- to postgresql-simple and are believed to not change between PostgreSQL
213-- versions.
214--
215------------------------------------------------------------------------------
217-- Note that this file is generated by tools/GenTypeInfo.hs, and should
218-- not be edited directly
220module Database.PostgreSQL.Simple.TypeInfo.Static
221 ( TypeInfo(..)
222 , staticTypeInfo
223|] ++ concat [ " , " ++ bs (hs name) ++ "\n"
224 | name <- names ] ++ [longstring|
225 ) where
227import Database.PostgreSQL.LibPQ (Oid(..))
228import Database.PostgreSQL.Simple.TypeInfo.Types
230staticTypeInfo :: Oid -> Maybe TypeInfo
231staticTypeInfo (Oid x) = case x of
232|] ++ concat [concat [ " ", renderOid byName name,
233 " -> Just ", bs (hs name), "\n"
234 ]
235 | name <- names ]
236 ++ [longstring|
237 _ -> Nothing
238|]
239 ++ concat [concat
240 [ "\n"
241 , bs (hs name), " :: TypeInfo\n"
242 , bs (hs name), " = Basic {\n"
243 , " typoid = ", fromString (show typoid), ",\n"
244 , " typcategory = '", Blaze.fromChar typcategory, "',\n"
245 , " typdelim = '", Blaze.fromChar typdelim, "',\n"
246 , " typname = \"", bs typname, "\"\n"
247 , " }\n"
248 ]
249 | name <- getNames byName names
250 , let (Just (TypeInfo{..})) = Map.lookup (pg name) byName])