{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module Capabilities(processCaps) where

import Data.Aeson
import Data.Text (Text, pack)
import qualified Data.HashMap.Strict as M
import qualified Data.Vector as V

import Data.Maybe (isJust, mapMaybe, fromMaybe)
import Internal (Timeouts(..))

processCaps :: Maybe Value -> Maybe Object
processCaps caps
  | Just (required, fallbacks) <- decodeCaps caps, isJust $ validateCap required =
    foldl mergeCaps (Just required) $ mapMaybe validateCap fallbacks
processCaps _ = Nothing

-- Manual decode, to ensure WebDriver specs are followed.
decodeCaps :: Maybe Value -> Maybe (Object, [Object])
decodeCaps (Just (Object obj))
    | Just (Object caps) <- "capabilities" `M.lookup` obj,
        required <- "alwaysMatch" `M.lookup` caps, fallbacks <- "firstMatch" `M.lookup` caps,
        fromMaybe True (isObj <$> required) =
      let required' = case required of {
        Just (Object o) -> o;
        _ -> nilCap
      } in case fallbacks of
        Just (Array fallbacks') | all isObj fallbacks' ->
            Just (required', [f | Object f <- V.toList fallbacks'])
        Nothing -> Just (required', [nilCap])
        _ -> Nothing
  where
    isObj (Object _) = True
    isObj _ = False
    nilCap = M.empty
decodeCaps _ = Nothing

validateCap :: Object -> Maybe Object
validateCap cap
    | and [isJust $ inner k v | (k, v) <- M.toList cap, v /= Null] = Just $ M.mapMaybeWithKey inner cap
    | otherwise = Nothing
  where
    inner _ Null = Nothing
    inner "acceptInsecureCertificates" v@(Bool _) = Just v -- What's the behavior here?
    inner "browserName" v@(String "rhapsode") = Just v
    inner "browserVersion" v@(String "5") = Just v
    inner "browserVersion" v@(String "4") = Just v
    inner "browserVersion" v@(String "3") = Just v
    inner "platformName" v@(String _) = Just v -- Rhapsode's very cross-platform.
    inner "pageLoadStrategy" v@(String v') | v' `elem` ["none", "eager", "normal"] = Just v -- Noop
    -- I don't support "proxy" yet.
    inner "timeouts" v | Success Timeouts {} <- fromJSON v = Just v
    inner "unhandledPromptBehavior" v@(String v')
        | v' `elem` ["dissmiss", "accept", "dismiss and accept", "accept and notify", "ignore"] = Just v -- Noop
    inner _ _ = Nothing

mergeCaps :: Maybe Object -> Object -> Maybe Object
mergeCaps (Just primary) secondary | M.null $ M.intersection primary secondary =
    Just $ M.union primary secondary