{-# 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 =
    [(String, TypeQ)] -> Map String TypeQ
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ ("INT",        [t|Int32|])
                 , ("INTEGER",    [t|Int32|])
                 , ("TINYINT",    [t|Int8|])
                 , ("SMALLINT",   [t|Int16|])
                 , ("MEDIUMINT",  [t|Int32|])
                 , ("BIGINT",     [t|Int64|])
                 , ("INT2",       [t|Int16|])
                 , ("INT8",       [t|Int64|])

                 , ("CHARACTER",  [t|String|])
                 , ("VARCHAR",    [t|String|])
                 , ("TEXT",       [t|String|])

                 , ("BLOB",       [t|ByteString|])

                 , ("REAL",       [t|Double|])
                 , ("DOUBLE",     [t|Double|])
                 , ("FLOAT",      [t|Float|])

                 , ("DATE",       [t|Day|])
                 , ("DATETIME",   [t|LocalTime|])
                 ]

normalizeColumn :: String -> String
normalizeColumn :: String -> String
normalizeColumn = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

normalizeType :: String -> String
normalizeType :: String -> String
normalizeType = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem " (")

notNull :: TableInfo -> Bool
notNull :: TableInfo -> Bool
notNull info :: TableInfo
info = Int16 -> Bool
forall a. (Eq a, Num a) => a -> Bool
isTrue (Int16 -> Bool) -> (TableInfo -> Int16) -> TableInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo -> Int16
TableInfo.notnull (TableInfo -> Bool) -> TableInfo -> Bool
forall a b. (a -> b) -> a -> b
$ TableInfo
info
  where
    isTrue :: a -> Bool
isTrue 0 = Bool
False
    isTrue _ = Bool
True

-- for backward compatibility
normalizeMap :: Map String TypeQ -> Map String TypeQ
normalizeMap :: Map String TypeQ -> Map String TypeQ
normalizeMap = [(String, TypeQ)] -> Map String TypeQ
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, TypeQ)] -> Map String TypeQ)
-> (Map String TypeQ -> [(String, TypeQ)])
-> Map String TypeQ
-> Map String TypeQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, TypeQ) -> (String, TypeQ))
-> [(String, TypeQ)] -> [(String, TypeQ)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> (String, TypeQ) -> (String, TypeQ)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((String -> String) -> (String, TypeQ) -> (String, TypeQ))
-> (String -> String) -> (String, TypeQ) -> (String, TypeQ)
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper) ([(String, TypeQ)] -> [(String, TypeQ)])
-> (Map String TypeQ -> [(String, TypeQ)])
-> Map String TypeQ
-> [(String, TypeQ)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String TypeQ -> [(String, TypeQ)]
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 mapFromSql :: Map String TypeQ
mapFromSql info :: TableInfo
info = do
    TypeQ
typ <- String -> Map String TypeQ -> Maybe TypeQ
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)
           Maybe TypeQ -> Maybe TypeQ -> Maybe TypeQ
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
           String -> Map String TypeQ -> Maybe TypeQ
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key Map String TypeQ
mapFromSqlDefault
    (String, TypeQ) -> Maybe (String, TypeQ)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> String
normalizeColumn (TableInfo -> String
TableInfo.name TableInfo
info), TypeQ -> TypeQ
mayNull TypeQ
typ)
  where
    key :: String
key = String -> String
normalizeType (String -> String) -> (TableInfo -> String) -> TableInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo -> String
TableInfo.ctype (TableInfo -> String) -> TableInfo -> String
forall a b. (a -> b) -> a -> b
$ TableInfo
info
    mayNull :: TypeQ -> TypeQ
mayNull typ :: TypeQ
typ = if TableInfo -> Bool
notNull TableInfo
info
                    then TypeQ
typ
                    else [t|Maybe $(typ)|]

tableInfoQuerySQL :: String -> String -> Query () TableInfo
tableInfoQuerySQL :: String -> String -> Query () TableInfo
tableInfoQuerySQL db :: String
db tbl :: String
tbl = String -> Query () TableInfo
forall p a. String -> Query p a
unsafeTypedQuery (String -> Query () TableInfo) -> String -> Query () TableInfo
forall a b. (a -> b) -> a -> b
$ "pragma " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
db String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".table_info(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tbl String -> String -> String
forall a. [a] -> [a] -> [a]
++ ");"

indexListQuerySQL :: String -> String -> Query () IndexList
indexListQuerySQL :: String -> String -> Query () IndexList
indexListQuerySQL db :: String
db tbl :: String
tbl = String -> Query () IndexList
forall p a. String -> Query p a
unsafeTypedQuery (String -> Query () IndexList) -> String -> Query () IndexList
forall a b. (a -> b) -> a -> b
$ "pragma " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
db String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".index_list(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tbl String -> String -> String
forall a. [a] -> [a] -> [a]
++ ");"

indexInfoQuerySQL :: String -> String -> Query () IndexInfo
indexInfoQuerySQL :: String -> String -> Query () IndexInfo
indexInfoQuerySQL db :: String
db idx :: String
idx = String -> Query () IndexInfo
forall p a. String -> Query p a
unsafeTypedQuery (String -> Query () IndexInfo) -> String -> Query () IndexInfo
forall a b. (a -> b) -> a -> b
$ "pragma " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
db String -> String -> String
forall a. [a] -> [a] -> [a]
++ ".index_info(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
idx String -> String -> String
forall a. [a] -> [a] -> [a]
++ ");"