{-# LANGUAGE TupleSections #-}
module Dodge.Debug.Terminal
    where
import MaybeHelp
import Dodge.Inventory.Add
import Dodge.Creature
import Dodge.Creature.Damage
--import Dodge.Creature.State
--import Dodge.Creature.YourControl
import Dodge.Data
import Dodge.Menu.PushPop
import Dodge.Item
import Control.Monad
--import Dodge.Base

import Control.Lens
import Text.Read (readMaybe)
import Data.List --(isPrefixOf, isInfixOf, intercalate)
import Data.Maybe
import Control.Applicative
import LensHelp
import qualified Data.Text as T
import qualified IntMapHelp as IM
--import qualified Debug.Trace
--import Graphics.Rendering.OpenGL.GL.Shaders (validateProgram)
--import Dodge.Data (Universe(Universe))

applyTerminalString :: [String] -> Universe -> Universe
applyTerminalString ss = case ss of
    [] -> id
    [s] -> applyTerminalCommand s
    (s:ss') -> applyTerminalCommandArguments s ss'

applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of
    "NOCLIP" -> config . debug_booleans . at Noclip %~ toggleJust
    "LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
        . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
    "LM"    -> applyTerminalCommand "LOADME"
    "LT"    -> applyTerminalCommand "LOADTEST"
    ['L',x]     -> (uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
        . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
    "GODON"     -> uvWorld . creatures . ix 0 . crApplyDamage .~ applyNoDamage
    "GODOFF"    -> uvWorld . creatures . ix 0 . crApplyDamage .~ defaultApplyDamage
    "LOADTEST"  -> (uvWorld . creatures . ix 0 . crInv .~ testInventory)
        . (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
    _ -> id
--applyTerminalString' ('s': 'e': 't': '_': 'h': 'p': ' ': hp)
--    | isNothing (readMaybe hp :: Maybe Int) = id
--    | otherwise = uvWorld . creatures . ix 0 . crHP .~ read hp
--applyTerminalString' ('s': 'e': 't': '_': 'i': 'n': 'v': 'c': 'a': 'p': ' ': n)
--    | isNothing (readMaybe n :: Maybe Int) = id
--    | otherwise = uvWorld . creatures . ix 0 . crInvCapacity .~ read n
--applyTerminalString' ('s': 'e': 't': ' ': var)
--    | var /= [] = applySetTerminalString var
--    | otherwise = id
--applyTerminalString' ('s': 'p': 'a': 'w': 'n': ' ': var)
--    | var /= [] = id -- work out how to spawn stuff
--    | otherwise = id
--applyTerminalString' _   = id

applyTerminalCommandArguments :: String -> [String] -> Universe -> Universe
applyTerminalCommandArguments command args u = case command of
    "ITEM" -> fromMaybe u $ do
        (ibt,n) <- parseItem args
        return $ u & uvWorld %~ flip (foldr ($)) (replicate n (snd . createPutItem (itemFromBase ibt)))
    _ -> u

parseItem :: [String] -> Maybe (ItemBaseType,Int)
parseItem (x:xs) 
    =   (readMaybe (x++" {_xNum=" ++ show (parseNum xs)++"}") <&> (,1))
    <|> (readMaybe x <&> (,parseNum xs) )
    <|> (readMaybe ("CRAFT "++x) <&> (,parseNum xs))
    <|> (readMaybe ("HELD {_ibtHeld="++x++"}") <&> (,parseNum xs))
    <|> (readMaybe ("EQUIP {_ibtEquip="++x++"}") <&> (,parseNum xs))
    <|> (readMaybe ("LEFT {_ibtLEFT="++x++"}") <&> (,parseNum xs))
    <|> (readMaybe ("HELD ("++x++" {_xNum=" ++ show (parseNum xs)++"}") <&> (,1))
    <|> parseItem (xs & ix 0 .++~ (x ++ " "))
parseItem [] = Nothing

parseNum :: [String] -> Int
parseNum xs = fromMaybe 1 $ xs ^? ix 0 >>= readMaybe

showTerminalError :: String -> String -> Universe -> Universe
showTerminalError cmd s = menuLayers .:~ InputScreen (T.pack cmd) s

applySetTerminalString :: String -> Universe -> Universe
applySetTerminalString [] = id
applySetTerminalString var = case key' of
    "" -> showTerminalError ("set "++var) ("Unable to read as argument as float: " ++ val)
    "hp" -> uvWorld . creatures . ix 0 . crHP .~ round (fromJust val')
    "invcap" -> uvWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
    "mass" -> uvWorld . creatures . ix 0 . crMass .~ fromJust val'
    "mvspeed" -> uvWorld . creatures . ix 0 . crMvType .mvSpeed .~ fromJust val'
    _ -> showTerminalError ("set "++var) ("Invalid set command: " ++ key) -- never reached?
    where
        (key, val) = getSplitString var
        val' = readMaybe val :: Maybe Float
        key' = if isNothing val' then "" else key

autoCompleteTerminal :: String -> String -> Universe -> IO (Maybe Universe)
autoCompleteTerminal s _ = return . 
    (popScreen' >=> pushScreen' (InputScreen (T.pack input_str) valid_commands))
  where
    (key, val) = getSplitString $ tail s
    command_options = case val of
        "" -> filter (isInfixOf key) (validTerminalCommands "")
        _ -> filter (isInfixOf val) (validTerminalCommands key)
    -- basic autocomplete if single option available (or as far as possible)
    input_str = case (key, val) of
        (_, "") -> if length command_options == 1 
            then ">" ++ head command_options ++ " " 
            else ">" ++ longestCommonPrefix command_options
        _ -> if length command_options == 1 
            then ">" ++ key ++ " " ++ head command_options ++ " " 
            else if null command_options 
                then s 
                else ">" ++ key ++ " " ++ longestCommonPrefix command_options
    command_options' = if not (null command_options) && head command_options == key 
        then validTerminalCommands key 
        else command_options

    --val' = Debug.Trace.trace key tail val
    valid_commands = "Options: " ++ intercalate ", " command_options'

getSplitString :: [Char] -> ([Char], [Char])
getSplitString str = case break (==' ') str of
    (a, _:b) -> (a, b)
    (a, _) -> (a, "")

isValidCommand :: String -> String -> Bool
isValidCommand arg1 arg2 = arg2 `elem` validTerminalCommands arg1

validTerminalCommands :: String -> [String]
validTerminalCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]
validTerminalCommands "god" = ["on", "off"]
validTerminalCommands _ = ["set", "spawn", "god"]

loadme :: a
loadme = undefined

longestCommonPrefix :: Eq a => [[a]] -> [a]
longestCommonPrefix [] = []
longestCommonPrefix lists = foldr1 commonPrefix lists

commonPrefix :: Eq a => [a] -> [a] -> [a]
commonPrefix (x:xs) (y:ys)
    | x == y    = x : commonPrefix xs ys
commonPrefix _ _ = []