{-# LANGUAGE TemplateHaskell #-}
module Database.Relational.Schema.SQLite3 (
module Database.Relational.Schema.SQLite3.Config,
getType, normalizeColumn, normalizeType, notNull,
tableInfoQuerySQL, indexListQuerySQL, indexInfoQuerySQL
) where
import qualified Data.Map as Map
import qualified Database.Relational.Schema.SQLite3.TableInfo as TableInfo
import Language.Haskell.TH (TypeQ)
import Control.Arrow (first)
import Control.Applicative ((<|>))
import Data.ByteString (ByteString)
import Data.Char (toLower, toUpper)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Map (Map)
import Data.Time (Day, LocalTime)
import Database.Relational (Query, unsafeTypedQuery)
import Database.Relational.Schema.SQLite3.Config
import Database.Relational.Schema.SQLite3.IndexInfo
import Database.Relational.Schema.SQLite3.IndexList
import Database.Relational.Schema.SQLite3.TableInfo
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault :: Map String TypeQ
mapFromSqlDefault =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (String
"INT", [t|Int32|])
, (String
"INTEGER", [t|Int32|])
, (String
"TINYINT", [t|Int8|])
, (String
"SMALLINT", [t|Int16|])
, (String
"MEDIUMINT", [t|Int32|])
, (String
"BIGINT", [t|Int64|])
, (String
"INT2", [t|Int16|])
, (String
"INT8", [t|Int64|])
, (String
"CHARACTER", [t|String|])
, (String
"VARCHAR", [t|String|])
, (String
"TEXT", [t|String|])
, (String
"BLOB", [t|ByteString|])
, (String
"REAL", [t|Double|])
, (String
"DOUBLE", [t|Double|])
, (String
"FLOAT", [t|Float|])
, (String
"DATE", [t|Day|])
, (String
"DATETIME", [t|LocalTime|])
]
normalizeColumn :: String -> String
normalizeColumn :: String -> String
normalizeColumn = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
normalizeType :: String -> String
normalizeType :: String -> String
normalizeType = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
" (")
notNull :: TableInfo -> Bool
notNull :: TableInfo -> Bool
notNull TableInfo
info = forall {a}. (Eq a, Num a) => a -> Bool
isTrue forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo -> Int16
TableInfo.notnull forall a b. (a -> b) -> a -> b
$ TableInfo
info
where
isTrue :: a -> Bool
isTrue a
0 = Bool
False
isTrue a
_ = Bool
True
normalizeMap :: Map String TypeQ -> Map String TypeQ
normalizeMap :: Map String TypeQ -> Map String TypeQ
normalizeMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList
getType :: Map String TypeQ -> TableInfo -> Maybe (String, TypeQ)
getType :: Map String TypeQ -> TableInfo -> Maybe (String, TypeQ)
getType Map String TypeQ
mapFromSql TableInfo
info = do
TypeQ
typ <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key (Map String TypeQ -> Map String TypeQ
normalizeMap Map String TypeQ
mapFromSql)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key Map String TypeQ
mapFromSqlDefault
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
normalizeColumn (TableInfo -> String
TableInfo.name TableInfo
info), forall {m :: * -> *}. Quote m => m Type -> m Type
mayNull TypeQ
typ)
where
key :: String
key = String -> String
normalizeType forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo -> String
TableInfo.ctype forall a b. (a -> b) -> a -> b
$ TableInfo
info
mayNull :: m Type -> m Type
mayNull m Type
typ = if TableInfo -> Bool
notNull TableInfo
info
then m Type
typ
else [t|Maybe $(typ)|]
tableInfoQuerySQL :: String -> String -> Query () TableInfo
tableInfoQuerySQL :: String -> String -> Query () TableInfo
tableInfoQuerySQL String
db String
tbl = forall p a. String -> Query p a
unsafeTypedQuery forall a b. (a -> b) -> a -> b
$ String
"pragma " forall a. [a] -> [a] -> [a]
++ String
db forall a. [a] -> [a] -> [a]
++ String
".table_info(" forall a. [a] -> [a] -> [a]
++ String
tbl forall a. [a] -> [a] -> [a]
++ String
");"
indexListQuerySQL :: String -> String -> Query () IndexList
indexListQuerySQL :: String -> String -> Query () IndexList
indexListQuerySQL String
db String
tbl = forall p a. String -> Query p a
unsafeTypedQuery forall a b. (a -> b) -> a -> b
$ String
"pragma " forall a. [a] -> [a] -> [a]
++ String
db forall a. [a] -> [a] -> [a]
++ String
".index_list(" forall a. [a] -> [a] -> [a]
++ String
tbl forall a. [a] -> [a] -> [a]
++ String
");"
indexInfoQuerySQL :: String -> String -> Query () IndexInfo
indexInfoQuerySQL :: String -> String -> Query () IndexInfo
indexInfoQuerySQL String
db String
idx = forall p a. String -> Query p a
unsafeTypedQuery forall a b. (a -> b) -> a -> b
$ String
"pragma " forall a. [a] -> [a] -> [a]
++ String
db forall a. [a] -> [a] -> [a]
++ String
".index_info(" forall a. [a] -> [a] -> [a]
++ String
idx forall a. [a] -> [a] -> [a]
++ String
");"