git.iko.soy/typeable/postgresql-simple
on e4bf797 help sign in
typeable/postgresql-simple/tools/GenBuiltinTypes.hs
180 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
87|]
89instance IsString Blaze.Builder where
90 fromString = Blaze.fromByteString . fromString
92main = do
93 conn <- connectPostgreSQL ""
94 xs <- query conn "SELECT typname::text, oid::int\
95 \ FROM pg_type\
96 \ WHERE typname IN ?"
97 (Only (In (sort (map fst builtins))))
98 close conn
99 let oidmap = Map.fromList xs :: Map
100 L.writeFile "../src/Database/PostgreSQL/Simple/BuiltinTypes.hs"
101 (Blaze.toLazyByteString (renderFile oidmap builtins))
103padCons str = fromString (replicate (len - B.length str) ' ')
104 where
105 len = maximum (map (B.length . snd) builtins)
107renderOid oidmap x
108 = case Map.lookup x oidmap of
109 Nothing -> error (B.unpack x)
110 Just (show -> n) -> fromString (replicate (4 - length n) ' ')
111 ++ fromString n
113renderOid' oidmap x
114 = case Map.lookup x oidmap of
115 Nothing -> error (B.unpack x)
116 Just (show -> n) -> fromString n
117 ++ fromString (replicate (4 - length n) ' ')
119bs = Blaze.fromByteString
121renderFile :: Map -> [(B.ByteString,B.ByteString)] -> Blaze.Builder
122renderFile oidmap builtins = ([longstring|
123{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
125------------------------------------------------------------------------------
126-- |
127-- Module: Database.PostgreSQL.Simple.BuiltinTypes
128-- Copyright: (c) 2011-2012 Leon P Smith
129-- License: BSD3
130-- Maintainer: Leon P Smith <leon@melding-monads.com>
131-- Stability: experimental
132--
133------------------------------------------------------------------------------
135-- Note that this file is generated by tools/GenBuiltinTypes.hs, and should
136-- not be edited directly
138module Database.PostgreSQL.Simple.BuiltinTypes
139 ( BuiltinType (..)
140 , builtin2oid
141 , oid2builtin
142 , builtin2typname
143 , oid2typname
144 ) where
146import Data.Typeable
147import Data.ByteString (ByteString)
148import qualified Database.PostgreSQL.LibPQ as PQ
150data BuiltinType
151 = |] ++ mconcat (intersperse "\n | " (map (Blaze.fromByteString . snd) builtins)) ++ [longstring|
153 deriving (Eq, Ord, Enum, Bounded, Read, Show, Typeable)
155builtin2oid :: BuiltinType -> PQ.Oid
156builtin2oid typ = PQ.Oid $ case typ of
157|] ++ mconcat [mconcat [ " ", bs y, padCons y, " -> "
158 , renderOid oidmap x, "\n" ]
159 | (x,y) <- builtins ] ++ [longstring|
161oid2builtin :: PQ.Oid -> Maybe BuiltinType
162oid2builtin (PQ.Oid x) = case x of
163|] ++ mconcat [mconcat [ " ", renderOid' oidmap x, " -> Just ", bs y, "\n" ]
164 | (x,y) <- builtins ] ++ [longstring|
165 _ -> Nothing
167builtin2typname :: BuiltinType -> ByteString
168builtin2typname typ = case typ of
169|] ++ mconcat [mconcat [ " ", bs y, padCons y, " -> ", bs x, "\n"]
170 | (x,y) <- builtins] ++ [longstring|
172oid2typname :: PQ.Oid -> Maybe ByteString
173oid2typname (PQ.Oid x) = case x of
174|] ++ mconcat [mconcat [ " ", renderOid' oidmap x, " -> Just ", bs x, "\n" ]
175 | (x,y) <- builtins ]
176 ++ " _ -> Nothing\n"
177 ++ mconcat [mconcat [ "\n"
178 , bs x, " :: ByteString\n"
179 , bs x, " = \"", bs x, "\"\n"]
180 | (x,_y) <- builtins ])