git.iko.soy/typeable/postgresql-simple
on 46605eb help sign in
typeable/postgresql-simple/tools/GenBuiltinTypes.hs
182 lines 5.1 kB history raw
1------------------------------------------------------------------------------
2-- |
3-- Module: GenBuiltinTypes
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 for the Object IDs associated with built-in typenames,
10-- and generates Haskell boilerplate to handle this mapping. The subset
11-- of types handled this way is easily modifiable, but note that
12-- user-defined types do not have stable oids, and can differ between
13-- databases or dumps/reloads.
14------------------------------------------------------------------------------
16{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-}
17module GenBuiltinTypes where
19import Prelude hiding ((++))
21import StringsQQ
22import Database.PostgreSQL.Simple
23import qualified Data.ByteString.Char8 as B
24import qualified Data.ByteString.Lazy as L
25import qualified Blaze.ByteString.Builder as Blaze
26import qualified Blaze.ByteString.Builder.ByteString as Blaze
27import qualified Blaze.ByteString.Builder.Char8 as Blaze
28import Data.String
29import Data.List ( sort, intersperse )
30import qualified Data.Map as Map
32import Data.Monoid
34(++) :: Monoid a => a -> a -> a
35(++) = mappend
36infixr 5 ++
38type Map = Map.Map B.ByteString Int
39builtins :: [(B.ByteString, B.ByteString)]
40builtins = [strings|
41bool
42bytea ByteA
43char
44name
45int8
46int2
47int4
48regproc RegProc
49text
50oid
51tid
52xid
53cid
54xml
55point
56lseg LSeg
57path
58box
59polygon
60line
61cidr
62float4
63float8
64abstime AbsTime
65reltime RelTime
66tinterval TInterval
67unknown
68circle
69money
70macaddr MacAddr
71inet
72bpchar BpChar
73varchar VarChar
74date
75time
76timestamp
77timestamptz TimestampTZ
78interval
79timetz TimeTZ
80bit
81varbit VarBit
82numeric
83refcursor RefCursor
84record
85void
86uuid UUID
87json JSON
88|]
90instance IsString Blaze.Builder where
91 fromString = Blaze.fromByteString . fromString
93main = do
94 conn <- connectPostgreSQL ""
95 xs <- query conn "SELECT typname::text, oid::int\
96 \ FROM pg_type\
97 \ WHERE typname IN ?"
98 (Only (In (sort (map fst builtins))))
99 close conn
100 let oidmap = Map.fromList xs :: Map
101 L.writeFile "../src/Database/PostgreSQL/Simple/BuiltinTypes.hs"
102 (Blaze.toLazyByteString (renderFile oidmap builtins))
104padCons str = fromString (replicate (len - B.length str) ' ')
105 where
106 len = maximum (map (B.length . snd) builtins)
108renderOid oidmap x
109 = case Map.lookup x oidmap of
110 Nothing -> error (B.unpack x)
111 Just (show -> n) -> fromString (replicate (4 - length n) ' ')
112 ++ fromString n
114renderOid' oidmap x
115 = case Map.lookup x oidmap of
116 Nothing -> error (B.unpack x)
117 Just (show -> n) -> fromString n
118 ++ fromString (replicate (4 - length n) ' ')
120bs = Blaze.fromByteString
122renderFile :: Map -> [(B.ByteString,B.ByteString)] -> Blaze.Builder
123renderFile oidmap builtins = ([longstring|
124{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
126------------------------------------------------------------------------------
127-- |
128-- Module: Database.PostgreSQL.Simple.BuiltinTypes
129-- Copyright: (c) 2011-2012 Leon P Smith
130-- License: BSD3
131-- Maintainer: Leon P Smith <leon@melding-monads.com>
132-- Stability: experimental
133--
134------------------------------------------------------------------------------
136-- Note that this file is generated by tools/GenBuiltinTypes.hs, and should
137-- not be edited directly
139module Database.PostgreSQL.Simple.BuiltinTypes
140 {-# DEPRECATED "Use TypeInfo instead" #-}
141 ( BuiltinType (..)
142 , builtin2oid
143 , oid2builtin
144 , builtin2typname
145 , oid2typname
146 ) where
148import Data.Typeable
149import Data.ByteString (ByteString)
150import qualified Database.PostgreSQL.LibPQ as PQ
152data BuiltinType
153 = |] ++ mconcat (intersperse "\n | " (map (Blaze.fromByteString . snd) builtins)) ++ [longstring|
155 deriving (Eq, Ord, Enum, Bounded, Read, Show, Typeable)
157builtin2oid :: BuiltinType -> PQ.Oid
158builtin2oid typ = PQ.Oid $ case typ of
159|] ++ mconcat [mconcat [ " ", bs y, padCons y, " -> "
160 , renderOid oidmap x, "\n" ]
161 | (x,y) <- builtins ] ++ [longstring|
163oid2builtin :: PQ.Oid -> Maybe BuiltinType
164oid2builtin (PQ.Oid x) = case x of
165|] ++ mconcat [mconcat [ " ", renderOid' oidmap x, " -> Just ", bs y, "\n" ]
166 | (x,y) <- builtins ] ++ [longstring|
167 _ -> Nothing
169builtin2typname :: BuiltinType -> ByteString
170builtin2typname typ = case typ of
171|] ++ mconcat [mconcat [ " ", bs y, padCons y, " -> ", bs x, "\n"]
172 | (x,y) <- builtins] ++ [longstring|
174oid2typname :: PQ.Oid -> Maybe ByteString
175oid2typname (PQ.Oid x) = case x of
176|] ++ mconcat [mconcat [ " ", renderOid' oidmap x, " -> Just ", bs x, "\n" ]
177 | (x,y) <- builtins ]
178 ++ " _ -> Nothing\n"
179 ++ mconcat [mconcat [ "\n"
180 , bs x, " :: ByteString\n"
181 , bs x, " = \"", bs x, "\"\n"]
182 | (x,_y) <- builtins ])