{-# LANGUAGE TemplateHaskell, OverloadedStrings, OverloadedLists, ViewPatterns, MultiParamTypeClasses, FlexibleContexts, RankNTypes, TypeSynonymInstances, FlexibleInstances #-}

module Sequence.Contact.Tests
  ( enactTest 
  ) where

import Sequence.Formula
import Sequence.Types
import Sequence.Utils
import Sequence.Contact.Types

import Control.Monad
import Control.Monad.Reader
import Control.Monad.Base
import Control.Lens

import Data.Default
import Data.List
import Data.Maybe
import Data.Monoid

import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

import Data.Traversable (mapM)

import Prelude hiding (mapM)

tests :: MonadReader Stats m => m (Map (CI String) (FormulaM Stats Test))
tests = do
  baseTests <- mconcat <$> sequence [ test "Stärke" $ sAStrength . attributeTest
                                    , test "Ausdauer" $ sAEndurance . attributeTest
                                    , test "Masse" $ sAMass . attributeTest
                                    , test "Reflexe" $ sAReflexes . attributeTest
                                    , test "Beweglichkeit" $ sAMobility . attributeTest
                                    , test "Geschicklichkeit" $ sADexterity . attributeTest
                                    , test "Intelligenz" $ sAIntelligence . attributeTest
                                    , test "Charisma" $ sACharisma . attributeTest
                                    , test "Wahrnehmung" $ sAPerception . attributeTest
                                    , test "Entschlossenheit" $ sAWillpower . attributeTest
 
                                    , test "Archaische Distanzwaffen" $ sSArchaicRanged . skillTest
                                    , test "Handfeuerwaffen" $ sSFirearms . skillTest
                                    , test "Schwere Waffen" $ sSHeavyWeapons . skillTest
                                    , test "Energiewaffen" $ sSEnergyWeapons . skillTest
                                    , test "Waffenloser Nahkampf" $ sSUnarmedMelee . skillTest
                                    , test "Bewaffneter Nahkampf" $ sSArmedMelee . skillTest
                                    , test "Wurfwaffen" $ sSThrownWeapons . skillTest
                                    , test "Tarnung & Schleichen" $ sSStealth . skillTest
                                    , test "Diebeshandwerk & Betrügerei" $ sSThievery . skillTest
                                    , test "Schlösser Knacken" $ sSLockpicking . skillTest
                                    , test "Fallen Stellen & Entschärfen" $ sSTrapping . skillTest
                                    , test "Naturwissenschaften" $ sSSciences . skillTest
                                    , test "Erste Hilfe" $ sSFirstAid . skillTest
                                    , test "Medizinische Praktik" $ sSMedicine . skillTest
                                    , test "Geisteswissenschaften" $ sSHumanities . skillTest
                                    , test "Ingenieurwesen & Reperatur" $ sSEngineering . skillTest
                                    , test "Handwerkskunst" $ sSCraft . skillTest
                                    , test "Interface" $ sSInterface . skillTest
                                    , test "Redekunst" $ sSSpeech . skillTest
                                    , test "Führung" $ sSLeadership . skillTest
                                    , test "Hauswirtschaft" $ sSHomeEconomics . skillTest
                                    , test "Überlebenskunst" $ sSSurvival . skillTest
                                    , test "Motorrad" $ sSMotorcycle . skillTest
                                    , test "Radfahrzeug" $ sSWheeled . skillTest
                                    , test "Schwebefahrzeug" $ sSHovercraft . skillTest
                                    , test "Tragflächenmaschine" $ sSAircraft . skillTest
                                    , test "Raumfahrzeug" $ sSSpacecraft . skillTest
                                    , test "Wasserfahrzeug" $ sSWatercraft . skillTest
                                    , test "Kettenfahrzeug" $ sSTracked . skillTest
                                    , test "Exoskelett" $ sSExoskeleton . skillTest

                                    , test "Beißen" $ sSBiting . skillTest
                                    , test "Aufspüren" $ sSSearching . skillTest
                                    , test "Betragen" $ sSDemeanour . skillTest

                                    , test "Rammen" $ sSRamming . skillTest
                                    , test "Zielerfassung" $ sSTargeting . skillTest
                                    , test "Verständnis" $ sSComprehension . skillTest
                                    ]

  views sExtraSkills (baseTests <>)
  where
    test k v = maybe mempty (Map.singleton k) <$> previews v (set (mapped . tName) k)

    skillTest = to (\x -> flip (set tBaseDifficulty) def <$> x)
    attributeTest = to (\x -> flip (set tBaseDifficulty) def . (* 10) <$> x) 


getTest :: String -> Fold Stats (FormulaM Stats Test)
getTest (CI.mk -> str) = folding tests'
  where
    tests' state = Map.lookup str (tests state) -- >>= (\get -> preview get state)

instance Completion (FormulaM Stats Test) GameState where
  completableLabel _ = "<test>"
  complete _ st (CI.foldCase -> prefix) = return . fromMaybe [] . fmap (map CI.original . filter ((prefix `isPrefixOf`) . CI.foldedCase) . Map.keys) $ previews (gFocus' . eStats) tests st

instance Argument (FormulaM Stats Test) GameState where
  arg str = join <$> preuses (gFocus' . eStats) (preview (getTest str))

enactTest :: Test -> FormulaM Stats TestResult
enactTest rawTest = do
  test <- foldM (&) rawTest =<< toListOf (ctx . sModifiers . folded . _Modifier . _2) <$> ask
  manualMod <- val ignored [CI.original (rawTest ^. tName), "Modifier"] False
  let
    critFailureBar = 95 - test^.tCritFailureMod
    critSuccessBar = 5 + test^.tCritSuccessMod
    bar = test^.tBaseDifficulty + test^.tMod + manualMod
    toResult pw = (toResult' pw) pw (abs $ bar - pw)
    toResult' pw
      | bar > critSuccessBar
      , pw <= critSuccessBar = CritSuccess
      | pw <= bar            = Success
      | pw >= critFailureBar = CritFailure
      | otherwise            = Failure
  toResult <$> d 100

-- hasTest :: Stats -> String -> Bool
-- hasTest stats str = has (getTest str) stats

-- rollTest :: String -> FormulaM Stats (Maybe TestResult)
-- rollTest str = preview (getTest str) >>= enactTest'
--   where
--     enactTest' Nothing = return Nothing
--     enactTest' (Just t) = Just <$> (enactTest =<< t)