git.iko.soy/typeable/postgresql-simple
on 2172aec help sign in
typeable/postgresql-simple/tools/GenBuiltinTypes.hs
185 lines 5.1 kB history raw
1------------------------------------------------------------------------------
2-- |
3-- Module: GenBuiltinTypes
4-- Copyright: (c) 2011 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
43char
44name
45int8
46int2
47int4
48regproc
49text
50oid
51tid
52xid
53cid
54xml
55point
56lseg
57path
58box
59polygon
60line
61cidr
62float4
63float8
64abstime
65reltime
66tinterval
67unknown
68circle
69money
70macaddr
71inet
72bpchar
73varchar
74date
75time
76timestamp
77timestamptz TimestampWithTimeZone
78interval
79timetz TimeWithTimeZone
80bit
81varbit
82numeric
83refcursor
84record
85void
86|]
88instance IsString Blaze.Builder where
89 fromString = Blaze.fromByteString . fromString
91main = do
92 conn <- connect ConnectInfo {
93 connectHost = "127.0.0.1",
94 connectPort = 5432,
95 connectUser = "aliadmin",
96 connectPassword = "aliadmin",
97 connectDatabase = "postgres"
98 }
99 xs <- query conn "SELECT typname::text, oid::int\
100 \ FROM pg_type\
101 \ WHERE typname IN ?"
102 (Only (In (sort (map fst builtins))))
103 close conn
104 let oidmap = Map.fromList xs :: Map
105 L.writeFile "../src/Database/PostgreSQL/Simple/BuiltinTypes.hs"
106 (Blaze.toLazyByteString (renderFile oidmap builtins))
108padCons str = fromString (replicate (len - B.length str) ' ')
109 where
110 len = maximum (map (B.length . snd) builtins)
112renderOid oidmap x
113 = case Map.lookup x oidmap of
114 Nothing -> error (B.unpack x)
115 Just (show -> n) -> fromString (replicate (4 - length n) ' ')
116 ++ fromString n
118renderOid' oidmap x
119 = case Map.lookup x oidmap of
120 Nothing -> error (B.unpack x)
121 Just (show -> n) -> fromString n
122 ++ fromString (replicate (4 - length n) ' ')
124bs = Blaze.fromByteString
126renderFile :: Map -> [(B.ByteString,B.ByteString)] -> Blaze.Builder
127renderFile oidmap builtins = ([longstring|
128{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
130------------------------------------------------------------------------------
131-- |
132-- Module: Database.PostgreSQL.Simple.BuiltinTypes
133-- Copyright: (c) 2011 Leon P Smith
134-- License: BSD3
135-- Maintainer: Leon P Smith <leon@melding-monads.com>
136-- Stability: experimental
137--
138------------------------------------------------------------------------------
140-- Note that this file is generated by tools/GenBuiltinTypes.hs, and should
141-- not be edited directly
143module Database.PostgreSQL.Simple.BuiltinTypes
144 ( BuiltinType (..)
145 , builtin2oid
146 , oid2builtin
147 , builtin2typname
148 , oid2typname
149 ) where
151import Data.Typeable
152import Data.ByteString (ByteString)
153import qualified Database.PostgreSQL.LibPQ as PQ
155data BuiltinType
156 = |] ++ mconcat (intersperse "\n | " (map (Blaze.fromByteString . snd) builtins)) ++ [longstring|
158 deriving (Eq, Ord, Enum, Bounded, Read, Show, Typeable)
160builtin2oid :: BuiltinType -> PQ.Oid
161builtin2oid typ = PQ.Oid $ case typ of
162|] ++ mconcat [mconcat [ " ", bs y, padCons y, " -> "
163 , renderOid oidmap x, "\n" ]
164 | (x,y) <- builtins ] ++ [longstring|
166oid2builtin :: PQ.Oid -> Maybe BuiltinType
167oid2builtin (PQ.Oid x) = case x of
168|] ++ mconcat [mconcat [ " ", renderOid' oidmap x, " -> Just ", bs y, "\n" ]
169 | (x,y) <- builtins ] ++ [longstring|
170 _ -> Nothing
172builtin2typname :: BuiltinType -> ByteString
173builtin2typname typ = case typ of
174|] ++ mconcat [mconcat [ " ", bs y, padCons y, " -> ", bs x, "\n"]
175 | (x,y) <- builtins] ++ [longstring|
177oid2typname :: PQ.Oid -> Maybe ByteString
178oid2typname (PQ.Oid x) = case x of
179|] ++ mconcat [mconcat [ " ", renderOid' oidmap x, " -> Just ", bs x, "\n" ]
180 | (x,y) <- builtins ]
181 ++ " _ -> Nothing\n"
182 ++ mconcat [mconcat [ "\n"
183 , bs x, " :: ByteString\n"
184 , bs x, " = \"", bs x, "\"\n"]
185 | (x,_y) <- builtins ])