{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}

module Ringo.Validator (validateEnv) where

import qualified Data.Map as Map
import qualified Data.Text as Text

import Prelude.Compat
import Control.Monad.Reader (Reader, ask, runReader)
import Data.Function        (on)
import Data.Maybe           (isJust, fromJust)
import Data.List            (nub, group, groupBy, sort)

import Ringo.Extractor.Internal
import Ringo.Types
import Ringo.Types.Internal
import Ringo.Utils

data RawEnv = RawEnv ![Table] ![Fact] !Settings !TypeDefaults deriving (Show)

checkTableForCol :: Table -> ColumnName -> [ValidationError]
checkTableForCol tab colName =
  [ MissingColumn (tableName tab) colName |
      not . any ((colName ==) . columnName) . tableColumns $ tab ]

validateTable :: Table -> Reader RawEnv [ValidationError]
validateTable table = do
  RawEnv tables _ _ _ <- ask
  return . concatMap (checkConstraint tables) . tableConstraints $ table
  where
    checkConstraint _ (PrimaryKey colName)    = checkTableForCol table colName
    checkConstraint _ (UniqueKey columnNames) = checkTableForColRefs table columnNames
    checkConstraint tables (ForeignKey oTableName columnNames) =
      case findTable oTableName tables of
        Just oTable -> checkTableForColRefs table (map fst columnNames)
                         ++ checkTableForColRefs oTable (map snd columnNames)
        Nothing     -> [ MissingTable oTableName ]

    checkTableForColRefs tab = concatMap (checkTableForCol tab)

validateFact :: Fact -> Reader RawEnv [ValidationError]
validateFact Fact {..} = do
  RawEnv tables _ _ typeDefaults <- ask
  let defaults = Map.keys typeDefaults
  case findTable factTableName tables of
    Nothing    -> return [ MissingTable factTableName ]
    Just table -> do
      tableVs           <- validateTable table
      parentVs          <- concat <$> mapM checkFactParents factParentNames
      let colVs         = concatMap (checkColumn tables table) factColumns
          timeVs        = [ MissingTimeColumn factTableName
                            | null ([ cName | FactColumn cName DimTime <- factColumns ] :: [ColumnName]) ]
          notNullVs     = [ MissingNotNullConstraint factTableName cName
                            | FactColumn cName DimTime <- factColumns
                            , let col                  = findColumn cName (tableColumns table)
                            , isJust col
                            , columnNullable (fromJust col) == Null ]
          typeDefaultVs =
            [ MissingTypeDefault cType
              | cName   <- [ c | FactColumn c DimVal {..} <- factColumns ]
                        ++ [ c | FactColumn c NoDimId     <- factColumns ]
                        ++ [ c | FactColumn c TenantId    <- factColumns ]
                        ++ [ c | FactColumn c DimId {..}  <- factColumns ]
              , let col = findColumn cName (tableColumns table)
              , isJust col
              , let cType = columnType $ fromJust col
              , not . any (`Text.isPrefixOf` cType) $ defaults ]

      return $ tableVs ++ parentVs ++ colVs ++ timeVs ++ notNullVs ++ typeDefaultVs
  where
    checkFactParents fName = do
      RawEnv _ facts _ _ <- ask
      case findFact fName facts of
        Nothing    -> return [ MissingFact fName ]
        Just pFact -> validateFact pFact

    checkColumn tables table factCol =
      maybe [] (checkTableForCol table) (factSourceColumnName factCol)
        ++ checkColumnTable tables factCol

    checkColumnTable :: [Table] -> FactColumn -> [ValidationError]
    checkColumnTable tables FactColumn {..} = case factColType of
      DimId {factColTargetTable = tName} -> maybe [ MissingTable tName ] (const []) $ findTable tName tables
      _                                  -> []

validateEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env
validateEnv tables facts settings@Settings {..} typeDefaults =
  flip runReader (RawEnv tables facts settings typeDefaults) $ do
    tableVs <- concat <$> mapM validateTable tables
    factVs  <- concat <$> mapM validateFact facts
    let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ]
    let dupFactVs  = [ DuplicateFact fact   | fact  <- findDups . map factName $ facts ]
    let dupColVs   = [ DuplicateColumn tableName col
                       | Table{..} <- tables
                       , col       <- findDups . map columnName $ tableColumns ]
    let dupDimVs   = facts
                     >>- concatMap (dimColumnMappings settingDimPrefix)
                     >>> sort
                     >>> groupBy ((==) `on` fst)
                     >>> filter (map snd >>> nub >>> length >>> (/= 1))
                     >>> map (head >>> fst >>> DuplicateDimension)
        vs = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs
    if null vs
      then return . Right $ Env tables facts settings typeDefaults
      else return . Left  $ vs
  where
    findDups =
      sort >>> group >>> map (head &&& length) >>> filter (snd >>> (> 1)) >>> map fst