{-# 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

--{-# ANN module "HLint: ignore Redundant $" #-}

-- <https://www.sqlite.org/datatype3.html>
-- SQLite3 is dynamic typing,
-- so assign narrower constraints in this default mapping.
-- Using upper case typenames along with SQLite3 document.
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

-- for backward compatibility
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 {- for backward compatibility -} 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
");"