------------------------------------------------------------------------------
-- |
-- Module:      GenBuiltinTypes
-- Copyright:   (c) 2011 Leon P Smith
-- License:     BSD3
-- Maintainer:  Leon P Smith <leon@melding-monads.com>
-- Stability:   experimental
--
-- Queries a PostgreSQL for the Object IDs associated with built-in typenames,
-- and generates Haskell boilerplate to handle this mapping.  The subset
-- of types handled this way is easily modifiable,  but note that
-- user-defined types do not have stable oids,  and can differ between
-- databases or dumps/reloads.
------------------------------------------------------------------------------

{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns #-}
module GenBuiltinTypes where

import Prelude hiding ((++))

import StringsQQ
import Database.PostgreSQL.Simple
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy  as L
import qualified Blaze.ByteString.Builder            as Blaze
import qualified Blaze.ByteString.Builder.ByteString as Blaze
import qualified Blaze.ByteString.Builder.Char8      as Blaze
import Data.String
import Data.List ( sort, intersperse )
import qualified Data.Map as Map

import Data.Monoid

(++) :: Monoid a => a -> a -> a
(++) = mappend
infixr 5 ++

type Map = Map.Map B.ByteString Int
builtins :: [(B.ByteString, B.ByteString)]
builtins = [strings|
bool
bytea
char
name
int8
int2
int4
regproc
text
oid
tid
xid
cid
xml
point
lseg
path
box
polygon
line
cidr
float4
float8
abstime
reltime
tinterval
unknown
circle
money
macaddr
inet
bpchar
varchar
date
time
timestamp
timestamptz TimestampWithTimeZone
interval
timetz      TimeWithTimeZone
bit
varbit
numeric
refcursor
record
void
|]

instance IsString Blaze.Builder where
   fromString = Blaze.fromByteString . fromString

main = do
  conn <- connect ConnectInfo {
              connectHost = "127.0.0.1",
              connectPort = 5432,
              connectUser = "aliadmin",
              connectPassword = "aliadmin",
              connectDatabase = "postgres"
            }
  xs <- query conn "SELECT typname::text, oid::int\
                   \  FROM pg_type\
                   \ WHERE typname IN ?"
              (Only (In (sort (map fst builtins))))
  close conn
  let oidmap = Map.fromList xs :: Map
  L.writeFile "../src/Database/PostgreSQL/Simple/BuiltinTypes.hs"
              (Blaze.toLazyByteString (renderFile oidmap builtins))

padCons str = fromString (replicate (len - B.length str) ' ')
  where
    len = maximum (map (B.length . snd) builtins)

renderOid oidmap x
  = case Map.lookup x oidmap of
      Nothing -> error (B.unpack x)
      Just (show -> n) -> fromString (replicate (4 - length n) ' ')
                       ++ fromString n

renderOid' oidmap x
  = case Map.lookup x oidmap of
      Nothing -> error (B.unpack x)
      Just (show -> n) -> fromString n
                       ++ fromString (replicate (4 - length n) ' ')

bs = Blaze.fromByteString

renderFile :: Map -> [(B.ByteString,B.ByteString)] -> Blaze.Builder
renderFile oidmap builtins = ([longstring|
{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}

------------------------------------------------------------------------------
-- |
-- Module:      Database.PostgreSQL.Simple.BuiltinTypes
-- Copyright:   (c) 2011 Leon P Smith
-- License:     BSD3
-- Maintainer:  Leon P Smith <leon@melding-monads.com>
-- Stability:   experimental
--
------------------------------------------------------------------------------

-- Note that this file is generated by tools/GenBuiltinTypes.hs, and should
-- not be edited directly

module Database.PostgreSQL.Simple.BuiltinTypes
     ( BuiltinType (..)
     , builtin2oid
     , oid2builtin
     , builtin2typname
     , oid2typname
     ) where

import Data.Typeable
import Data.ByteString (ByteString)
import qualified Database.PostgreSQL.LibPQ as PQ

data BuiltinType
   = |] ++ mconcat (intersperse "\n   | " (map (Blaze.fromByteString . snd) builtins)) ++ [longstring|

     deriving (Eq, Ord, Enum, Bounded, Read, Show, Typeable)

builtin2oid :: BuiltinType -> PQ.Oid
builtin2oid typ = PQ.Oid $ case typ of
|] ++ mconcat [mconcat [ "  ", bs y, padCons y, " -> "
                       , renderOid oidmap x, "\n" ]
               | (x,y) <- builtins ] ++ [longstring|

oid2builtin :: PQ.Oid -> Maybe BuiltinType
oid2builtin (PQ.Oid x) = case x of
|] ++ mconcat [mconcat [ "  ", renderOid' oidmap x, " -> Just ", bs y, "\n" ]
               | (x,y) <- builtins ] ++ [longstring|
  _    -> Nothing

builtin2typname :: BuiltinType -> ByteString
builtin2typname typ = case typ of
|] ++ mconcat [mconcat [ "  ", bs y, padCons y, " -> ", bs x, "\n"]
               | (x,y) <- builtins] ++ [longstring|

oid2typname :: PQ.Oid -> Maybe ByteString
oid2typname (PQ.Oid x) = case x of
|] ++ mconcat [mconcat [ "  ", renderOid' oidmap x, " -> Just ", bs x, "\n" ]
               | (x,y) <- builtins ]
               ++        "  _ -> Nothing\n"
   ++ mconcat [mconcat [ "\n"
                       , bs x, " :: ByteString\n"
                       , bs x, " = \"", bs x, "\"\n"]
               | (x,_y) <- builtins ])