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