{-|
module Internal.     : Data.Basic.TH.Types
Description : Data types and utility function used during TH generation phase
Copyright   : (c) Nikola Henezi, 2016-2017
                  Luka Horvat, 2016-2017
License     : MIT

This module Internal.defines data types that are used during parsing and TH generation stages. They describe
structure of the parser and define minimal representation that is needed from parser in order to
generate Template Haskell.


-}
module Internal.Data.Basic.TH.Types where

import Internal.Interlude hiding (Type)

import           Data.Text                          (append)

import qualified Language.Haskell.TH.Syntax         as TH
import qualified Database.HsSqlPpp.Syntax           as SQL

import           Data.Time
import           Data.Scientific

-- | When something goes wrong, this explains what went wrong - hopefully...
data ParseError = ParseError Text deriving (Show)

instance Semigroup ParseError where
  (<>) (ParseError a) (ParseError b) = ParseError (a `append` b)

instance Monoid ParseError where
  mempty = ParseError ""
  mappend = (<>)

-- | List of constraints that can be applied to a Column and affect generated datatype
-- Currently, only Null constraint affects it by wrapping data type with 'Maybe'
data ColumnConstraint = NullConstraint | NotNullConstraint | DefaultConstraint deriving (Show, Eq)

-- | Column information gathered from a parser
data ColumnInfo = ColumnInfo { _columnInfoText        :: !Text,    -- ^ name retrieved from the parser
                               _columnInfoNormalName  :: !Text,    -- ^ normalized name of the field
                               _columnInfoName        :: !TH.Name, -- ^ generate TH name
                               _columnInfoType        :: !TH.Type, -- ^ generated TH type
                               _columnInfoSqlType     :: !SQL.TypeName, -- ^ original sql type
                               _columnInfoConstraints :: ![ColumnConstraint] -- ^ list of constraints that have to be applied
                             } deriving (Show)
makeLenses ''ColumnInfo
instance Eq ColumnInfo where
  (==) a b = _columnInfoName a == _columnInfoName b

-- | Entity information gathered from a parser
data EntityInfo = EntityInfo { _entityInfoText :: !Text, -- ^ name retrieved from the parser, basically a computed value of 'SQL.Name'
                               _entityInfoName :: !TH.Name, -- ^ generated TH name
                               _entityInfoSQLName :: !SQL.Name, -- ^ original sql name retrieved by hssqlpp
                               _entityInfoType :: !TH.Type, -- ^ generated datatype
                               _entityInfoConstraintList :: ![SQL.Constraint], -- ^ list of constraints that have to be applied
                               _entityInfoColumnMap :: [ColumnInfo] -- ^ list of all columns
                             } deriving (Show)
instance Eq EntityInfo where
  (==) a b = _entityInfoName a == _entityInfoName b

makeLenses ''EntityInfo

-- | Minimal context we need to generate a foreign key constraint
data ForeignKeyConstraint = ForeignKeyConstraint { _fkName :: !Text, -- ^ name of the foreign key
                                                   _fkFromT :: !EntityInfo,
                                                   _fkFromCols :: ![ColumnInfo],
                                                   _fkToT :: !EntityInfo, -- ^ referenced entity
                                                   _fkToCols :: ![ColumnInfo] -- ^ referenced columns
                                                 } deriving (Show)

makeLenses ''ForeignKeyConstraint

-- | Minimal context we need to generate a unique key constraint
data UniqueKeyConstraint = UniqueKeyConstraint { _uqName :: !Text, -- ^ name of the constraint
                                                 _uqEntity :: !EntityInfo, -- ^ referenced entity
                                                 _uqCols :: ![ColumnInfo] -- ^ referenced columns
                                               } deriving (Show)
makeLenses ''UniqueKeyConstraint

-- | Minimal context we need to generate a primary key constraint
data PrimaryKeyConstraint = PrimaryKeyConstraint { _pkName :: !Text, -- ^ name of the constraint
                                                   _pkEntity :: !EntityInfo, -- ^ referenced entity
                                                   _pkCols :: ![ColumnInfo] -- ^ referenced columns
                                                 } deriving (Show)
makeLenses ''PrimaryKeyConstraint

-- | Full parse context. This datatype is filled with information as parser goes trough the sql
-- file. After 'ParseContext' is filled, TH takes over and code generation starts.
data ParseContext = ParseContext { _entities :: ![EntityInfo], -- ^ list of entities found
                                   _fks :: ![ForeignKeyConstraint], -- ^ all foreign keys
                                   _pks :: ![PrimaryKeyConstraint], -- ^ all primary keys
                                   _uqs :: ![UniqueKeyConstraint] -- ^ all unique constraints
                                 } deriving (Show)
makeLenses ''ParseContext

instance Semigroup ParseContext where
    (<>) (ParseContext ei1 fk1 pk1 uq1) (ParseContext ei2 fk2 pk2 uq2) =
      ParseContext (ei1 <> ei2) (fk1 <> fk2) (pk1 <> pk2) (uq1 <> uq2)

instance Monoid ParseContext where
   mempty = ParseContext mempty mempty mempty mempty
   mappend = (<>)

-- | Defines null values for all datatypes that we support in Basic.
-- This is basically a hack to avoid usage of unsafeCoerce, because with unsafeCoerce
-- you can hit segmentation faults due to wrong memory allocation (e.g. 'Int' and 'Bool').
class NullValue a where
    nullValue :: a

instance NullValue Int where nullValue = 0
instance NullValue Bool where nullValue = False
instance NullValue LocalTime where nullValue = LocalTime (ModifiedJulianDay 0) nullValue
instance NullValue TimeOfDay where nullValue = TimeOfDay 0 0 0
instance (NullValue a, NullValue b) => NullValue (a, b) where nullValue = (nullValue, nullValue)
instance NullValue Double where nullValue = 0
instance NullValue Text where nullValue = ""
instance NullValue Scientific where nullValue = 0
instance NullValue Day where nullValue = ModifiedJulianDay 0
instance NullValue ByteString where nullValue = ""
instance NullValue (Maybe a) where nullValue = Nothing

newtype Schema = Schema Text