{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}

module Dodge.Terminal (
    makeTermLine,
    textInputBlurb,
    textTerminal,
    simpleTermMessage,
    damageCodeCommand,
    makeColorTermLine,
    makeTermPara,
    terminalReturnEffect,
    getCommands,
--    tabComplete,
    tlSetStatus,
    tlDoEffect,
    termTextColor,
    doTabComplete,
    recComFindSuccessor,
    recComFindPredecessor,
    recComFindMin,
    recComFindMax,
    recComLookup,
) where

import Color
import Data.Char
import qualified Data.List as List
import qualified Data.ListTrie.Patricia.Map.Enum as PTE
import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Data.Terminal.Status
import Dodge.Data.World
import Dodge.Default
import Dodge.SoundLogic
import Dodge.Terminal.Type
import Justify
import LensHelp
import Sound.Data

textTerminal :: Terminal
textTerminal = defaultTerminal{_tmBootLines = textInputBlurb []}

textInputBlurb :: [TerminalLine] -> [TerminalLine]
textInputBlurb tls =
    [termSoundLine computerBeepingS]
        <> tls
        <> tlSetStatus (TerminalTextInput "")

termSoundLine :: SoundID -> TerminalLine
termSoundLine = TLine 0 [] . TmWdWdTermSound

termTextColor :: Color
termTextColor = greyN 0.9

--type TCommands = PTE.TrieMap Char (PTE.TrieMap Char [TerminalLine])
type TCommands = RecCommands [TerminalLine]

getCommands :: World -> Terminal -> TCommands
getCommands w tm = foldMap (getCommand w tm) $ tm ^. tmCommands

getCommand :: World -> Terminal -> TCom -> TCommands
getCommand w tm = \case
    TCInfo x z -> RCommands $ PTE.singleton x (Right (makeTermPara z))
    TCBase -> quitCommand <> toggleCommands tm
    TCDamageCommand -> damageCodeCommand w tm

damageCodeCommand :: World -> Terminal -> TCommands
damageCodeCommand w _ = RCommands .
    PTE.singleton "DAMAGECODE" . Left . RCommands $ PTE.fromList $ mapMaybe f [minBound ..]
  where
    f :: SensorType -> Maybe (String, Either TCommands [TerminalLine])
    f st = do
        s <- g st
        return (s, Right $ decodeSensorType st w)
    g =
        fmap (map toUpper . reverse)
            . List.stripPrefix (reverse "Sensor")
            . reverse
            . show

decodeSensorType :: SensorType -> World -> [TerminalLine]
decodeSensorType st w = fromMaybe [] $ do
    x <- w ^? cWorld . cwGen . cwgParams . sensorCoding . ix st
    return [makeTermLine $ show x]

toggleCommands :: Terminal -> TCommands
toggleCommands tm
    | null ts = mempty
    | otherwise = RCommands . PTE.singleton "TOGGLE" . Left . RCommands . PTE.fromList 
        $ f <$> M.toList ts
  where
    ts = tm ^. tmToggles
    f (s, x) =
        ( s
        , Right
            [ TLine
                1
                [TerminalLineConst (s ++ " TOGGLE DONE!") termTextColor]
                (TmWdWdfromWdWd (WdWdNegateTrig $ x ^. ttTriggerID))
            ]
        )

--helpPara :: [TerminalLine]
--helpPara = makeTermPara "THIS TERMINAL PROCESSES KEYBOARD INPUT. USE [RETURN] OR [LMB] TO REGISTER YOUR INPUT. AVAILABLE COMMANDS CAN BE SCROLLED THROUGH, HOLD [RMB] TO SCROLL THROUGH ARGUMENTS. USE [TAB] FOR AUTOCOMPLETE."

quitCommand :: TCommands
quitCommand = RCommands . PTE.singleton "QUIT" $ Right [TLine 0 [] TmWdWdPowerDownTerminal]

makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine termTextColor

tlSetStatus :: TerminalStatus -> [TerminalLine]
tlSetStatus x = tlDoEffect $ TmTmSetStatus x

tlDoEffect :: TmWdWd -> [TerminalLine]
tlDoEffect x = [TLine 1 [] x]

makeTermPara :: String -> [TerminalLine]
makeTermPara = makeColorTermPara termTextColor

makeColorTermPara :: Color -> String -> [TerminalLine]
makeColorTermPara col = map (makeColorTermLine col) . makeParagraph 55

makeColorTermLine :: Color -> String -> TerminalLine
makeColorTermLine col str = TLine 1 [TerminalLineConst str col] TmWdId

commandColor :: Color
commandColor = yellow

--tabComplete :: World -> Terminal -> Terminal
--tabComplete w tm = fromMaybe tm $ do
--    s <- tm ^? tmStatus . tiText
--    return $ tabComplete' s w tm
--
---- ugly, can improve output to explain when showing available arguments
--tabComplete' :: String -> World -> Terminal -> Terminal
--tabComplete' s' w tm = case PTE.lookup s $ getCommands w tm of
--    Just m -> f (s ++ " ") $ PTE.toList $ PTE.lookupPrefix a m
--    Nothing -> f "" $ PTE.toList $ PTE.lookupPrefix s $ getCommands w tm
--  where
--    ss = words s'
--    s = fromMaybe "" $ ss ^? ix 0
--    a = fromMaybe "" $ ss ^? ix 1
--    f y m' = case fmap fst m' of
--        [] -> tm
--        [x] -> tm & tmStatus . tiText .~ (y ++ x)
--        xs ->
--            tm
--                & tmStatus
--                .~ TerminalLineRead
--                & tmFutureLines
--                .~ ( makeColorTermPara
--                        commandColor
--                        (unwords xs)
--                        <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s']
--                   )

data TabCompletion a
    = TabMatch a
    | TabComplete String
    | TabMultiComplete [String]
    | TabFail

data RecCommands a = 
    RCommands {_rCommands :: (PTE.TrieMap Char (Either (RecCommands a) a))}

-- assumes that each command Trie has at least one successful command
recComFindMin :: RecCommands a -> Maybe ([String], a)
recComFindMin (RCommands m) = case PTE.findMin m of
    Just (s,Right a) -> Just ([s],a)
    Just (s,Left m') -> recComFindMin m' & _Just . _1 .:~ s
    Nothing -> Nothing

recComFindMax :: RecCommands a -> Maybe ([String], a)
recComFindMax (RCommands m) = case PTE.findMax m of
    Just (s,Right a) -> Just ([s],a)
    Just (s,Left m') -> recComFindMax m' & _Just . _1 .:~ s
    Nothing -> Nothing

recComLookup :: [String] -> RecCommands a -> Maybe a
recComLookup (s:ss) (RCommands t) = do
    x <- PTE.lookup s t
    case x of
        Left m -> recComLookup ss m
        Right y -> return y
recComLookup [] _ = Nothing

-- assumes that the commands are well-formed, i.e. every tree does end in a
-- command
recComFindSuccessor :: [String] -> RecCommands a -> Maybe ([String],a)
recComFindSuccessor (s:ss) (RCommands m)
    | Just (Left rm) <- PTE.lookup s m
    , Just (ss', x) <- recComFindSuccessor ss rm = Just (s:ss',x)
    | otherwise = case PTE.findSuccessor s m of
            Just (s',Right x) -> Just ([s'],x)
            Just (s',Left rm') -> recComFindMin rm' & _Just . _1 .:~ s'
            Nothing -> Nothing
recComFindSuccessor [] rm = recComFindMin rm

recComFindPredecessor :: [String] -> RecCommands a -> Maybe ([String],a)
recComFindPredecessor (s:ss) (RCommands m)
    | Just (Left rm) <- PTE.lookup s m
    , Just (ss', x) <- recComFindPredecessor ss rm = Just (s:ss',x)
    | otherwise = case PTE.findPredecessor s m of
            Just (s',Right x) -> Just ([s'],x)
            Just (s',Left rm') -> recComFindMax rm' & _Just . _1 .:~ s'
            Nothing -> Nothing
recComFindPredecessor [] rm = recComFindMax rm
--
--recComFindPredecessor :: [String] -> RecCommands a -> Maybe ([String],a)
--recComFindPredecessor (s:ss) (RCommands m) = Nothing

instance Semigroup (RecCommands a) where
    RCommands x <> RCommands y = RCommands $ x <> y

instance Monoid (RecCommands a) where
    mempty = RCommands mempty
    

tbComplete :: String -> PTE.TrieMap Char a -> TabCompletion a
tbComplete s t = case e of
    [] | Just x <- mx -> TabMatch x
    [] -> case fmap fst $ PTE.toList t' of
        [] -> TabFail
        ss -> TabMultiComplete ss
    _ -> TabComplete e
  where
    (e, mx, t') = PTE.splitPrefix $ PTE.deletePrefix s t

recTabComplete :: String -> TCommands -> TabCompletion [TerminalLine]
recTabComplete s (RCommands t) = fromMaybe (TabMultiComplete $ allstrings $ t) $ do
    (s1,ss) <- stripHead $ words s
    case tbComplete s1 t of
        TabComplete e -> return $ TabComplete e
        TabMultiComplete es -> return $ TabMultiComplete (fmap (s1 <>) es)
        TabFail -> return $ TabFail
        TabMatch (Right x) -> return $ TabMatch x
        TabMatch (Left rm) -> return $ recTabComplete (unwords ss) rm
  where
    stripHead (x:xs) = Just (x,xs)
    stripHead _ = Nothing
    allstrings = fmap fst . PTE.toList

doTabComplete :: World -> Terminal -> Terminal
doTabComplete w tm = fromMaybe tm $ do
    s <- tm ^? tmStatus . tiText
    case recTabComplete s $ getCommands w tm of
        TabMatch _ -> return tm
        TabComplete e -> return $ tm & tmStatus . tiText <>~ e
        TabMultiComplete ss -> return $ tm 
            & tmStatus .~ TerminalLineRead
            & tmFutureLines .~ 
            [TLine 0 [TerminalLineConst (getPromptTM <> s) termTextColor] TmWdId] <>
            (makeColorTermPara commandColor (unwords ss) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
        TabFail -> return tm

-- damageCodeCommand :: TerminalCommand
-- damageCodeCommand =
--    TerminalCommand
--        { _tcString = "DAMAGECODE"
--        , _tcAlias = ["DCODE", "DC"]
--        , _tcHelp = "Displays the shape and color associated with a given damage type."
--        , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
--        }

-- infoClearInput :: Terminal -> [TerminalLine] -> World -> World
-- infoClearInput tm tls =
--    cWorld . lWorld . terminals . ix (_tmID tm)
--        %~ ( (tmInput .~ TerminalInput T.empty True (0, 0))
--                . (tmFutureLines ++.~ tls)
--           )

-- togglesToEffects :: Terminal -> M.Map String [TerminalLine]
-- togglesToEffects = fmap f . _tmToggles
--  where
--    f tt = [TLine 0 [] $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)]

simpleTermMessage :: [String] -> Terminal
simpleTermMessage strs = defaultTerminal & tmBootLines .~ map makeTermLine strs

-- list available arguments on function input?
terminalReturnEffect :: Int -> World -> World
terminalReturnEffect tmid w = w 
    & cWorld . lWorld . terminals . ix tmid %~ terminalReturnLocal w

terminalReturnLocal :: World -> Terminal -> Terminal
terminalReturnLocal w tm = fromMaybe tm $ do
    s <- tm ^? tmStatus . tiText
    return $ tm 
        & tmFutureLines .~ [TLine 0 [TerminalLineConst (getPromptTM <> s) termTextColor] TmWdId]
        & case recTabComplete s $ getCommands w tm of
            TabMatch x -> (tmStatus .~ TerminalLineRead )
                . (tmFutureLines <>~ (x<>tlSetStatus (TerminalTextInput "")))
            TabComplete e -> tmStatus . tiText <>~ e
            TabMultiComplete ss ->
                (tmStatus .~ TerminalLineRead)
                . ( tmFutureLines <>~ 
                (makeColorTermPara commandColor (unwords ss) <> [TLine 1 [] . TmTmSetStatus $ TerminalTextInput s])
                )
            TabFail -> id

-- fromMaybe w $ do
--    tm' <- w ^? cWorld . lWorld . terminals . ix tmid
--    let tm = tabComplete w tm'
--    s <- tm ^? tmStatus . tiText
--    let ss = fromMaybe [makeTermLine "ERROR: INPUT NOT RECOGNISED"] $ do
--            let args = words s
--            case args of
--                [] -> return helpPara
--                (x : _) -> do
--                    teff <- PTE.lookup x (getCommands w tm)
--                    let y = fromMaybe "" (args ^? ix 1)
--                    PTE.lookup y teff
--    return $
--        w
--            & totm
--            . tmDisplayedLines
--            .:~ (getPromptTM ++ s, termTextColor)
--            & totm
--            . tmFutureLines
--            .~ ss
--            <> tlSetStatus (TerminalTextInput "")
--                & totm
--                . tmCommandHistory
--                %~ take 10
--                . (s :)
--                & totm
--                . tmStatus
--                .~ TerminalLineRead
--  where
--    totm = cWorld . lWorld . terminals . ix tmid