module Internal.Data.Basic.TH.Compiler where

import qualified Control.Lens.Internal.FieldTH as LTHI
import qualified Data.Text                     as T
import           Internal.Interlude            hiding (Type)
import           Language.Haskell.TH           hiding (Name)
import qualified Language.Haskell.TH.Syntax    as TH
import           Database.HsSqlPpp.Parse
import qualified Database.HsSqlPpp.Syntax      as SQL

import           Control.Effects.Signal
import qualified Internal.Data.Basic.TH.Generator       as G
import           Internal.Data.Basic.TH.Helper
import           Internal.Data.Basic.TH.Types
import           Internal.Data.Basic.TH.SqlToHsTypes


compileSQL :: Text -> Q (Either ParseError [SQL.Statement])
compileSQL filename = do
  contents <- runIO $ liftIO $ readFile $ toS filename
  return $ runIdentity (handleToEither $ liftError $ parseProcSQL defaultParseFlags (toS filename) Nothing (toS contents))

compileContext :: ParseContext -> Q [Dec]
compileContext c = do
      let _entities = G.dataConstructor <$> c ^. entities
      let result = concat $ compileEntity c <$> c ^. entities
      let constraints = G.allConstraints c
      let fieldOptics = G.fieldOptics (c ^. entities)
      let fkOptics = G.fkOptics (c ^. fks)
      let virtualFields = G.virtualTables (c ^. fks)
      lenses <- concat <$> sequence (LTHI.makeFieldOpticsForDec lensRules <$> _entities)
      let tableFields = G.tableFields (c ^. entities)
      return $ concat [ _entities
                      , result
                      , constraints
                      , lenses
                      , tableFields
                      , fieldOptics
                      , fkOptics
                      , virtualFields]

compileEntity :: ParseContext -> EntityInfo -> [Dec]
compileEntity ctx info = G.tableInstance ctx info <>
  [G.fromRowInstance name cols] <>
  G.emptyEntity ctx info <>
  G.initialAccessor info
  where cols = info ^. entityInfoColumnMap
        name = _entityInfoName info


compileSQLStatements :: (Throws ParseError m, MonadIO m)
                   => ParseContext -> [SQL.Statement] -> m ParseContext
compileSQLStatements = foldlM compileSQLStatement

-- | Updates 'CompileContext' with data. The kind of data that is being added depends on the
--   statement being processed.
compileSQLStatement :: (Throws ParseError m, MonadIO m) => ParseContext -> SQL.Statement -> m ParseContext
compileSQLStatement initialCtx (SQL.CreateTable _ name attrs constraints _ _) = do
  (ctx, ei) <- foldM (\(_ctx, _ei) attr -> updateContext _ctx entityName _ei attr) (initialCtx, entityInfo) attrs
  finalCtx <- foldM (\_ctx c -> compileConstraint ctx ei c) ctx constraints
  namedEi <- nameUnnamedConstraints ei
  return $ finalCtx {_entities = finalCtx ^. entities <> [namedEi] }
  where entityName = mkName (toS $ normalizeTable $ toS $ getName name)
        n = toS $ getName name
        entityInfo = EntityInfo n entityName name (ConT entityName) constraints mempty
compileSQLStatement ctx (SQL.AlterTable _ tableName (SQL.AlterTableActions _ l)) =
  foldrM (\s _ctx -> handleAlterTableOperations _ctx tableName s) ctx l
compileSQLStatement ctx p = do
  print $ "Compile error: only CREATE TABLE statement can be parsed " `T.append` show p
  return ctx

-- | Updates 'CompileContext' with constraints that have been added using alter table
handleAlterTableOperations :: Throws ParseError m
                           => ParseContext -> SQL.Name -> SQL.AlterTableAction -> m ParseContext
handleAlterTableOperations ctx tableName (SQL.AddConstraint _ (SQL.PrimaryKeyConstraint _ name tables)) = do
    fromEntity <- getEntityByName tableName (ctx ^. entities)
    columns <- mapM (getColumn fromEntity) (toS. SQL.ncStr <$> tables)
    return $ ctx & pks .~ (ctx ^. pks <> [PrimaryKeyConstraint (toS name) fromEntity columns])
handleAlterTableOperations ctx tableName (SQL.AddConstraint _ (SQL.UniqueConstraint _ name tables)) = do
    fromEntity <- getEntityByName tableName (ctx ^. entities)
    columns <- mapM (getColumn fromEntity) (toS. SQL.ncStr <$> tables)
    return $ ctx & uqs .~ (ctx ^. uqs <> [UniqueKeyConstraint (toS name) fromEntity columns])
handleAlterTableOperations ctx tableName (SQL.AddConstraint _ (SQL.ReferenceConstraint _ refName fromTables toTable toTables _ _)) = do
    toEntity <- getEntityByName toTable $ ctx ^. entities
    fromEntity <- getEntityByName tableName (ctx ^. entities)
    fromColumns <- mapM (getColumn fromEntity) (toS. SQL.ncStr <$> fromTables)
    toColumns <- mapM (getColumn toEntity) (toS. SQL.ncStr <$> toTables)
    return $ ctx & fks .~ (ctx ^. fks <> [ForeignKeyConstraint (toS refName) fromEntity fromColumns toEntity toColumns])
handleAlterTableOperations _ _ _ = throwSignal
    $ ParseError "Compile error: only PRIMARY KEY, UNIQUE and FOREIGN KEY constraints are implemented"

-- | Updates compile context from CREATE TABLE statement.
--   Used when CREATE TABLE statement is used. Adds to 'CompileContext' any constraints that are found and returns updated
--   'EntityInfo' and 'CompileContext'
updateContext :: Throws ParseError m => ParseContext -> TH.Name -> EntityInfo -> SQL.AttributeDef -> m (ParseContext, EntityInfo)
updateContext ctx entityName ei (SQL.AttributeDef _ nameC typ _ consts) = do
  (columnHsType, constraints) <- toHsType typ
  let g = ColumnInfo name normName (mkName (toS $ "_" <> lowerFirst (toS $ nameBase entityName) <> "_" <> name)) columnHsType typ constraints
  (ctx2, ci) <- foldM (\(_ctx, _ci) cons -> compileRowConstraint _ctx ei _ci cons) (ctx, g) consts
  return (ctx2, ei & entityInfoColumnMap .~ (ei ^. entityInfoColumnMap <> [ci]))
  where name = toS $ SQL.ncStr nameC
        normName = normalizeName name

-- | Adds sql row constraints to compile context
compileRowConstraint :: Throws ParseError m => ParseContext -> EntityInfo -> ColumnInfo -> SQL.RowConstraint -> m (ParseContext, ColumnInfo)
compileRowConstraint ctx _ ci (SQL.NullConstraint _ _) = return (ctx, ci & columnInfoConstraints .~ (ci ^. columnInfoConstraints <> [NullConstraint]))
compileRowConstraint ctx _ ci (SQL.NotNullConstraint _ _) = return (ctx, ci & columnInfoConstraints .~ (ci ^. columnInfoConstraints <> [NotNullConstraint]))
compileRowConstraint ctx ei ci (SQL.RowUniqueConstraint _ name) = return (ctx & uqs .~ ( ctx ^. uqs <> [UniqueKeyConstraint (toS name) ei [ci]])
                                                                         , ci & columnInfoConstraints .~ (ci ^. columnInfoConstraints <> [NotNullConstraint]))
compileRowConstraint ctx ei ci (SQL.RowPrimaryKeyConstraint _ name) = return (ctx & pks .~ (ctx ^. pks <> [PrimaryKeyConstraint (toS name) ei [ci]])
                                                                             , ci & columnInfoConstraints .~ (ci ^. columnInfoConstraints <> [NotNullConstraint]))
compileRowConstraint ctx ei ci (SQL.RowReferenceConstraint a name toTable mToColumn _ _) = do
  toEntityInfo <- getEntityByName toTable (ctx ^. entities)
  toColumnInfo <- maybe (throwSignal $ ParseError err) (getColumn toEntityInfo . toS . SQL.ncStr) mToColumn
  return (ctx & fks .~ (ctx ^. fks <> [ForeignKeyConstraint (toS name) ei [ci] toEntityInfo [toColumnInfo]]), ci)
  where err = "Compile error: Unable to find column " <> show a
compileRowConstraint ctx _ ci _ = return (ctx, ci)

-- | Adds sql constraint to compile context. If a sql constraint is unnamed, it will be named.
compileConstraint :: Throws ParseError m => ParseContext -> EntityInfo -> SQL.Constraint -> m ParseContext
compileConstraint ctx ei c = do
  constraint <- nameUnnamedConstraint ei c
  compileConstraint' ctx ei constraint

-- | Adds sql constraint to compile context.
compileConstraint' :: Throws ParseError m => ParseContext -> EntityInfo -> SQL.Constraint -> m ParseContext
compileConstraint' ctx ei (SQL.UniqueConstraint _ name tables) = do
  columnsInformation <- sequence $ getColumn ei <$> (toS. SQL.ncStr <$> tables)
  return $ ctx & uqs .~ (ctx ^. uqs <> [UniqueKeyConstraint (toS name) ei columnsInformation])
compileConstraint' ctx ei (SQL.PrimaryKeyConstraint _ name tables) = do
  columnsInformation <- sequence $ getColumn ei <$> (toS. SQL.ncStr <$> tables)
  return $ ctx & pks .~ (ctx ^. pks <> [PrimaryKeyConstraint (toS name) ei columnsInformation])
compileConstraint' ctx ei (SQL.ReferenceConstraint _ name fromTables toTableName toTables _ _) = do
  fromColumnsInfo <- sequence $ getColumn ei <$> (toS. SQL.ncStr <$> fromTables)
  toEntityInfo <- getEntityByName toTableName (ctx ^. entities)
  toColumnsInfo <- sequence $ getColumn toEntityInfo <$> (toS. SQL.ncStr <$> toTables)
  return $ ctx & fks .~ (ctx ^. fks <> [ForeignKeyConstraint (toS name) ei fromColumnsInfo toEntityInfo toColumnsInfo])
compileConstraint' _ _ a = throwSignal $ ParseError $ "Compile error: constraint not supported " <> show a