module Test.WebDriver.Capabilities.Aeson where

import Data.Aeson as A
import Data.Char
import Data.Function
import qualified Data.List as L


baseOptions :: A.Options
baseOptions :: Options
baseOptions = Options
A.defaultOptions { omitNothingFields = True }

toCamel1, toCamel2, toCamel3 :: A.Options
toCamel1 :: Options
toCamel1 = Options
baseOptions { A.fieldLabelModifier = snakeToCamelCase . toSnakeAndDropN 1 . dropLeadingUnderscore }
toCamel2 :: Options
toCamel2 = Options
baseOptions { A.fieldLabelModifier = snakeToCamelCase . toSnakeAndDropN 2 . dropLeadingUnderscore }
toCamel3 :: Options
toCamel3 = Options
baseOptions { A.fieldLabelModifier = snakeToCamelCase . toSnakeAndDropN 3 . dropLeadingUnderscore }

toCamelC1, toCamelC2, toCamelC3, toCamelC4 :: A.Options
toCamelC1 :: Options
toCamelC1 = Options
baseOptions { A.constructorTagModifier = snakeToCamelCase . toSnakeAndDropN 1 }
toCamelC2 :: Options
toCamelC2 = Options
baseOptions { A.constructorTagModifier = snakeToCamelCase . toSnakeAndDropN 2 }
toCamelC3 :: Options
toCamelC3 = Options
baseOptions { A.constructorTagModifier = snakeToCamelCase . toSnakeAndDropN 3 }
toCamelC4 :: Options
toCamelC4 = Options
baseOptions { A.constructorTagModifier = snakeToCamelCase . toSnakeAndDropN 4 }

-- | For 'UserPromptHandler', which maps things like
-- UserPromptHandlerAcceptAndNotify -> "accept and notify"
toSpacedC3 :: A.Options
toSpacedC3 :: Options
toSpacedC3 = Options
baseOptions { A.constructorTagModifier = snakeToSpaced . toSnakeAndDropN 3 }

-- | For FailedCommandError
toSpacedC0 :: A.Options
toSpacedC0 :: Options
toSpacedC0 = Options
baseOptions {
  A.constructorTagModifier = snakeToSpaced . toSnakeAndDropN 0
  , A.sumEncoding = A.UntaggedValue
  }

capabilitiesOptions :: A.Options
capabilitiesOptions :: Options
capabilitiesOptions = Options
baseOptions {
  A.fieldLabelModifier = specialCases . snakeToCamelCase . toSnakeAndDropN 1 . dropLeadingUnderscore
  }
  where
    specialCases :: a -> a
specialCases a
"googChromeOptions" = a
"goog:chromeOptions"
    specialCases a
"mozFirefoxOptions" = a
"moz:firefoxOptions"
    specialCases a
x = a
x


-- * Util

toSnakeAndDropN :: Int -> String -> String
toSnakeAndDropN :: Int -> String -> String
toSnakeAndDropN Int
n String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"_" [String]
snakeParts
  where
    snakeParts :: [String]
    snakeParts :: [String]
snakeParts = String
s
                 String -> (String -> String) -> String
forall a b. a -> (a -> b) -> b
& String -> String
dropLeadingUnderscore
                 String -> (String -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& (Char -> Bool) -> String -> [String]
splitR Char -> Bool
isUpper
                 [String] -> ([String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
L.drop Int
n
                 [String] -> ([String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower)

splitR :: (Char -> Bool) -> String -> [String]
splitR :: (Char -> Bool) -> String -> [String]
splitR Char -> Bool
_ [] = []
splitR Char -> Bool
p String
s =
  let
    go :: Char -> String -> [String]
    go :: Char -> String -> [String]
go Char
m String
s' = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break Char -> Bool
p String
s' of
      (String
b', [])     -> [ Char
mChar -> String -> String
forall a. a -> [a] -> [a]
:String
b' ]
      (String
b', Char
x:String
xs) -> ( Char
mChar -> String -> String
forall a. a -> [a] -> [a]
:String
b' ) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Char -> String -> [String]
go Char
x String
xs
  in case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break Char -> Bool
p String
s of
    (String
b,  [])    -> [ String
b ]
    ([], Char
h:String
t) -> Char -> String -> [String]
go Char
h String
t
    (String
b,  Char
h:String
t) -> String
b String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Char -> String -> [String]
go Char
h String
t

snakeToCamelCase :: String -> String
snakeToCamelCase :: String -> String
snakeToCamelCase String
s = case [String]
parts of
  (String
x:[String]
xs) -> String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
capitalize [String]
xs
  [] -> String
""
  where
    parts :: [String]
parts = case (Char -> Bool) -> String -> [String]
splitR (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') String
s of
      (String
x:[String]
xs) -> String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> String
forall a. Int -> [a] -> [a]
L.drop Int
1) [String]
xs)
      [] -> []

snakeToSpaced :: String -> String
snakeToSpaced :: String -> String
snakeToSpaced String
s = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
" " [String]
parts
  where
    parts :: [String]
parts = case (Char -> Bool) -> String -> [String]
splitR (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') String
s of
      (String
x:[String]
xs) -> String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> String -> String
forall a. Int -> [a] -> [a]
L.drop Int
1) [String]
xs)
      [] -> []

dropLeadingUnderscore :: [Char] -> [Char]
dropLeadingUnderscore :: String -> String
dropLeadingUnderscore (Char
'_':String
xs) = String
xs
dropLeadingUnderscore String
xs = String
xs

capitalize :: String -> String
capitalize :: String -> String
capitalize (Char
x:String
xs) = Char -> Char
toUpper Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower String
xs)
capitalize String
x = String
x