------------------------------------------------------------------------------
-- |
-- Module:      GenBuiltinTypes
-- Copyright:   (c) 2011-2012 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       ByteA
char
name
int8
int2
int4
regproc     RegProc
text
oid
tid
xid
cid
xml
point
lseg        LSeg
path
box
polygon
line
cidr
float4
float8
abstime     AbsTime
reltime     RelTime
tinterval   TInterval
unknown
circle
money
macaddr     MacAddr
inet
bpchar      BpChar
varchar     VarChar
date
time
timestamp
timestamptz TimestampTZ
interval
timetz      TimeTZ
bit
varbit      VarBit
numeric
refcursor   RefCursor
record
void
uuid        UUID
|]

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

main = do
  conn <- connectPostgreSQL ""
  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-2012 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 ])