0 | module Postgres.LoadTypes
  1 |
  2 | import Postgres.Data.PostgresType
  3 | import Postgres.Data.Conn
  4 | import Postgres.Query
  5 | import Postgres.Result
  6 | import Decidable.Equality
  7 | import Data.List
  8 | import Data.Vect
  9 | import Data.Vect.Elem
 10 | import Data.String
 11 | import Data.Either
 12 |
 13 | integerTypeStrings : List String
 14 | integerTypeStrings = [
 15 |     "int2",
 16 |     "int4",
 17 |     "int8"
 18 |   ]
 19 |
 20 | doubleTypeStrings : List String
 21 | doubleTypeStrings = [
 22 |     "float4",
 23 |     "float8",
 24 |     "numeric"
 25 |   ]
 26 |
 27 | charTypeStrings : List String
 28 | charTypeStrings = ["char"]
 29 |
 30 | booleanTypeStrings : List String
 31 | booleanTypeStrings = ["bool"]
 32 |
 33 | dateTypeStrings : List String
 34 | dateTypeStrings = ["date"]
 35 |
 36 | timeTypeStrings : List String
 37 | timeTypeStrings = [
 38 |     "time",
 39 |     "timetz"
 40 |   ]
 41 |
 42 | datetimeTypeStrings : List String
 43 | datetimeTypeStrings = [
 44 |     "timestamp",
 45 |     "timestamptz"
 46 |   ]
 47 |
 48 | stringTypeStrings : List String
 49 | stringTypeStrings = [
 50 |     "text",
 51 |     "varchar",
 52 |     "cstring",
 53 |     "name" -- maybe its own type that is just _castable_ to String?
 54 |   ]
 55 |
 56 | jsonTypeStrings : List String
 57 | jsonTypeStrings = [
 58 |     "json",
 59 |     "jsonb"
 60 |   ]
 61 |
 62 | uuidTypeStrings : List String
 63 | uuidTypeStrings = ["uuid"]
 64 |
 65 | oidTypeStrings : List String
 66 | oidTypeStrings = ["oid"]
 67 |
 68 | quote : String -> String
 69 | quote str = (strCons '\'' str) ++ "'"
 70 |
 71 | typeQuery : String
 72 | typeQuery = "SELECT oid, typname from pg_type where typname in (" ++ queryTypes ++ ")"
 73 |   where
 74 |     supportedTypes : List String
 75 |     supportedTypes = integerTypeStrings 
 76 |                   ++ doubleTypeStrings 
 77 |                   ++ charTypeStrings
 78 |                   ++ booleanTypeStrings
 79 |                   ++ dateTypeStrings
 80 |                   ++ timeTypeStrings
 81 |                   ++ datetimeTypeStrings
 82 |                   ++ stringTypeStrings
 83 |                   ++ jsonTypeStrings
 84 |                   ++ uuidTypeStrings
 85 |                   ++ oidTypeStrings
 86 |
 87 |     -- This is a bit fragile but we currently load types in by their common names
 88 |     -- and postgres names array types the same as the type the array contains with
 89 |     -- a leading underscore.
 90 |     queryTypes : String
 91 |     queryTypes = joinBy "," $ quote <$> (((strCons '_') <$> supportedTypes) ++ supportedTypes)
 92 |
 93 | parseOid : Maybe String -> Either String Oid
 94 | parseOid oid = do str <- maybeToEither "Found null when looking for Oid" oid
 95 |                   maybeToEither "Found non-integer Oid" $
 96 |                     MkOid <$> parseInteger str
 97 |
 98 | arrayOrNot : (isArray : Bool) -> PType -> PType
 99 | arrayOrNot True ty = PArray ty
100 | arrayOrNot False ty = ty
101 |
102 | ||| Using the groupings of Postgres string names for types that will
103 | ||| map to each PType, parse the given string to a PType (or POther)
104 | parseType : String -> PType
105 | parseType type = case isElem True typeSearch of
106 |                       (No _)  => POther type
107 |                       (Yes e) => case elemToFin e of
108 |                                       0  => arrayOrNot (fst typeSpec) PInteger
109 |                                       1  => arrayOrNot (fst typeSpec) PDouble
110 |                                       2  => arrayOrNot (fst typeSpec) PChar
111 |                                       3  => arrayOrNot (fst typeSpec) PBoolean
112 |                                       4  => arrayOrNot (fst typeSpec) PDate
113 |                                       5  => arrayOrNot (fst typeSpec) PTime
114 |                                       6  => arrayOrNot (fst typeSpec) PDatetime
115 |                                       7  => arrayOrNot (fst typeSpec) PString
116 |                                       8  => arrayOrNot (fst typeSpec) PJson
117 |                                       9  => arrayOrNot (fst typeSpec) PUuid
118 |                                       10 => arrayOrNot (fst typeSpec) POid
119 |   where
120 |     ||| First element of tuple is true if the type
121 |     ||| is an array. Second element of tuple is the
122 |     ||| name of the non-array type (because array types
123 |     ||| are named the same as non-array types but with
124 |     ||| a leading underscore).
125 |     typeSpec : (Bool, String)
126 |     typeSpec = case (strM type) of
127 |                  (StrCons '_' type') => (True, type')
128 |                  _                   => (False, type)
129 |
130 |     typeSearch : Vect ? Bool
131 |     typeSearch = elem (snd typeSpec) <$> 
132 |                    [integerTypeStrings 
133 |                   , doubleTypeStrings 
134 |                   , charTypeStrings
135 |                   , booleanTypeStrings
136 |                   , dateTypeStrings
137 |                   , timeTypeStrings
138 |                   , datetimeTypeStrings
139 |                   , stringTypeStrings
140 |                   , jsonTypeStrings
141 |                   , uuidTypeStrings
142 |                   , oidTypeStrings]
143 |
144 | typeResult : Vect 2 (Maybe String) -> Either String (Oid, PType)
145 | typeResult [oid, type] = [(o, parseType t) | o <- parseOid oid, t <- (maybeToEither "Found null when looking for type" type)]
146 |
147 | ||| Load Postgres types into a type dictionary. This is needed so that future queries
148 | ||| can identify the types of columns in responses.
149 | export
150 | pgLoadTypes : HasIO io => Conn -> io (Either String TypeDictionary)
151 | pgLoadTypes conn =
152 |   do Right (r ** 2 ** resultset) <- liftIO $ pgStringResultsQuery {types=empty} False typeQuery conn 
153 |        | Right (_ ** c ** _) => pure $ Left $ "ERROR: expected 2 columns but got " ++ (show c)
154 |        | Left err            => pure $ Left $ "ERROR: " ++ err
155 |      -- could change following to successfully parse a subset of types even when failing on one of them.
156 |      Right types <- pure $ traverse typeResult resultset
157 |        | Left err => pure $ Left $ "ERROR: " ++ err
158 |      pure $ Right $ typeDictionary $ toList types
159 |
160 |