-----------------------------------------------------------------------------
-- |
-- Module      : Internal.Data.Basic.TH.SqlToHsTypes
-- Copyright   :  (c) Nikola Henezi, Luka Horvat
-- License     :  MIT
--
-- Maintainer  :  nikola@henezi.com, luka.horvat9@gmail.com
--
-- Conversion between Postgres types and haskell datatypes. As a starting point,
-- 'fromField' from Database.PostgreSQL.Simple.FromField is used.
-- If you need support for additional datatypes, please open an issue
-- (https://gitlab.com/haskell-hr/basic) or email maintainers
-----------------------------------------------------------------------------
module Internal.Data.Basic.TH.SqlToHsTypes (toHsType) where

import qualified Data.Text                     as T
import           Data.Time.LocalTime           (LocalTime, TimeOfDay)
import           Data.Time                     (Day)
import           Internal.Interlude            hiding (Type)
import           Language.Haskell.TH           hiding (Name)
import qualified Database.HsSqlPpp.Syntax      as SQL
import           Data.Scientific

import           Control.Effects.Signal
import           Internal.Data.Basic.TH.Helper
import           Internal.Data.Basic.TH.Types

-- | Conversion between 'SQL.TypeName' to haskell 'Type'.
--  'SQL.TypeName' is used internaly by 'Database.HsSqlPpp'
toHsType :: Throws ParseError m => SQL.TypeName -> m (Type, [ColumnConstraint])
toHsType (SQL.SimpleTypeName _ name) = do
  t <- columnTypeToHs n
  return (t, applyColumnConstraints n)
  where n = getName name
toHsType (SQL.PrecTypeName _ name _) = do
  t <- columnTypeToHs n
  return (t, applyColumnConstraints n)
  where n = getName name
toHsType (SQL.Prec2TypeName _ name _ _) = do
  t <- columnTypeToHs n
  return (t, applyColumnConstraints n)
  where n = getName name
toHsType x = throwSignal $ ParseError $ "Compile error: unknown column type " <> show x

-- | Applies special constraint rules.
--   Rules:
--   "serial" type needs to have 'NotNullConstraint'
applyColumnConstraints :: Text -> [ColumnConstraint]
applyColumnConstraints fname
  | fname == "serial" = [NotNullConstraint, DefaultConstraint]
  | otherwise = []

-- | Actual conversions. The following Postgres types are currently supported:
-- > serial
-- > bigint
-- > integer
-- > int
-- > int4
-- > boolean
-- > timestamp
-- > time
-- > point
-- > double precision
-- > double
-- > character varying
-- > text
-- > bytea
-- > date
-- > numeric
columnTypeToHs :: Throws ParseError m => Text -> m Type
columnTypeToHs fname
  | fname `elem` ["serial", "bigint", "integer", "int", "int4"] = use ''Int
  | fname == "boolean" = use ''Bool
  | fname == "timestamp" = use ''LocalTime
  | fname == "time" = use ''TimeOfDay
  | fname == "point" = return $ AppT (AppT (TupleT 2) (ConT ''Double)) (ConT ''Double)
  | fname `elem` ["double precision", "double"] = use ''Double
  | fname `elem` ["character varying", "text"] = use ''Text
  | fname == "numeric" = use ''Scientific
  | fname == "date" = use ''Day
  | fname == "bytea" = use ''ByteString
  | otherwise = throwSignal $ ParseError $ "Compile error: cannot deduct Haskell type " `T.append` toS fname
  where use x = return $ ConT x