{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

module Network.OnRmt.UI.CmdLine (cmdLineUI, cmdLineStatus) where

import           Concurrent.Worker (WorkMsg, StateCmd(..), WorkMsg(..),
                                    WorkItems(..), WorkId, WorkState(..),
                                    DispBlk(..))
import           Control.Concurrent
import           Control.Exception (SomeException(..), toException)
import           Control.Monad (unless)
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Trans.State.Lazy
import           Data.Char (isSpace)
import           Data.Either (rights, lefts)
import qualified Data.List.Safe as L
import           Data.Maybe (fromMaybe, catMaybes, mapMaybe)
import           Data.Monoid ((<>))
import qualified Data.Set as S
import qualified Data.Text as T
import           Network.OnRmt.UI
import           System.REPL
import qualified System.REPL.Prompt as PR


data CmdLineCfg = CmdLineConfig T.Text (Chan StateCmd)


data CmdLineState = CmdLineState
    -- KWQ: store the WorkGroup here; allows getEntry and name and such, especially in select
    { workItems :: [WorkItems]
    , workerDescr :: Maybe (WorkId -> WorkState -> T.Text)
    , workerStates :: [WorkState]
    , stateChan :: Chan StateCmd
    , selectedItems :: S.Set Int
    , command :: T.Text
    }

instance Show CmdLineState where
  show cls = num <> " remotes" <> breakdown
    where num = show $ length $ workItems cls
          completed = st8msg numDone "completed"
          failed = st8msg numFailed "failed"
          inProgress = st8msg numInProgress "in progress"
          numDone = st8count WorkDone
          numFailed = st8count WorkFailed
          numInProgress = st8count WorkInProgress
          st8count st8 = length $ filter (st8 ==) $ workerStates cls
          st8msg cnt label = if cnt == 0 then Nothing else Just $ show cnt <> " " <> label
          interesting = catMaybes [ completed, failed, inProgress ]
          breakdown = if null interesting then ""
                      else " (" <> L.intercalate ", " interesting <> ")"


instance OnRmtUI CmdLineCfg CmdLineState where
    startUI = startCmdLine
    setUIItems s i f = return $ CmdLineState i f [] (stateChan s) mempty "id"
    newOutput s d = do putStrLn ""
                       addOutput s d
    addOutput s d = do case d of
                         DispInp i -> putStrLn $ "$ " <> T.unpack (T.unwords i)
                         DispOut o -> putStr $ unlines $ map T.unpack o
                         DispErr e -> mapM_ (putStrLn . (" ERR> " <>) . T.unpack) e
                         DispInfo i -> mapM_ (putStrLn . ("INFO> " <>) . T.unpack) i
                       return s
    setProgress s txt pct = let msg = T.unpack txt <> ": " <> show pct <> "%"
                            in do liftIO $ putStrLn msg
                                  return s
    addLogInfo s t = do putStrLn $ "-<[" <> T.unpack t <> "]>-"
                        return s
    setItemState s v i = do putStrLn $ "Remote #" <> show i <> " is " <> show v
                            let s'p = take i $ workerStates s <> repeat NoWork
                                s's = drop (i+1) $ workerStates s
                                s' = s'p <> [v] <> s's
                            return $ s { workerStates = s' }
    endInfo = return


-- Returns the final status of the CmdLineState
cmdLineStatus :: CmdLineState -> String
cmdLineStatus = const "good"  --KWQ


numItems :: [WorkItems] -> Int
numItems = sum . map numI
    where numI (WorkGroup _ i) = numI i
          numI (WorkItems n) = n


itemRange s = [0 .. numItems (workItems s) - 1]

showItems = map (showItemEntry [])
showItemEntry pfx (WorkGroup n i) = showItemEntry (n:pfx) i
showItemEntry [] (WorkItems n) = show n <> " entries"
showItemEntry pfx (WorkItems n) = let pstr = T.intercalate "." (reverse pfx)
                                  in T.unpack pstr <> " : " <> show n <> " entries"


getPrefix :: CmdLineState -> WorkId -> T.Text
getPrefix cmdState n = getpfx n $ workItems cmdState
    where getpfx :: Int -> [WorkItems] -> T.Text
          getpfx n [] = ""
          getpfx n (w:ws) =
              let (p,s) = pfxWsize w
              in if n < s
                 then p
                 else getpfx (n-s) ws
          pfxWsize (WorkGroup g i) =
              let (p,s) = pfxWsize i
              in if T.null p
                 then if T.null g then (g,s) else (g <> ": ", s)
                 else (g <> "." <> p, s)
          pfxWsize (WorkItems i) = ("", i)


getState :: CmdLineState -> WorkId -> WorkState
getState cmdState n = if n >= length (workerStates cmdState)
                      then NoWork
                      else workerStates cmdState !! n

itemDesc cmdState =
  let noDescInfo a b = "#" <> T.pack (show a) <> " -- " <> T.pack (show b)
  in fromMaybe noDescInfo $ workerDescr cmdState

matchGroup grp g = or [ (grp <> ".") `T.isPrefixOf` g
                      , (grp <> ":") `T.isPrefixOf` g
                      ]

-- ----------------------------------------------------------------------
-- UI Functionality

cmdLineUI appName =
    do eventChan <- newChan :: IO (Chan StateCmd)
       return (CmdLineConfig appName eventChan, writeChan eventChan, undefined)


startCmdLine :: CmdLineCfg -> (WorkMsg -> IO ()) -> CmdLineState -> IO CmdLineState
startCmdLine (CmdLineConfig appName stateChan) workReq _ =
    do putStrLn (T.unpack appName)
       event <- readChan stateChan
       ui' <- stateEventHandler initialState event
       putStrLn "Type \"help\" for a list of commands"
       putStrLn ""
       let prompt = PR.prompt' $ T.unpack appName <> "> "
       let cmd_op = makeREPL cmdlist cmd_exit cmd_unknown prompt defErrorHandler
       execStateT cmd_op ui'
    where initialState = CmdLineState [] Nothing [] stateChan mempty "id"
          cmdlist = [ cmd_list
                    , cmd_show
                    , cmd_info workReq
                    , cmd_select
                    , cmd_clear workReq
                    , cmd_runtest workReq
                    , cmd_setcommand
                    , cmd_run workReq
                    , cmd_help cmdlist
                    , cmd_exit
                    ]

cmd_unknown =
    makeCommandN "" (const True) "" False [] (repeat lineAsker) f
    where f t ts = unless (T.all isSpace t && L.all (T.all isSpace) ts)
                   $ liftIO $ putStrLn $ "Unknown command: " <> T.unpack t


cmd_help cmdlist = makeCommand "help / ?" (`elem` ["help", "?"])
                   "Shows help information"
                   $ \t -> liftIO $ summarizeCommands cmdlist


cmd_list = makeCommand "list" ("list" ==)
           "Lists all known remotes"
           $ \t -> do cmdState <- get
                      liftIO $ putStrLn $ unlines $ showItems $ workItems cmdState
                      let si  = selectedItems cmdState
                          sel = if null si then "none" else show (S.toList si)
                      liftIO $ putStrLn $ "Selection: " <> sel
                      liftIO $ putStrLn ""


cmd_show = makeCommandN "show" ("show"==)
           "Shows information about remotes. \n\
            \\t\tThe optional argument specifies which subset of remotes to show:\n\
            \\t\t       selected -- shows all currently selected items\n\
            \\t\t       results  -- shows all non-idle remotes\n\
            \\t\t       failed   -- shows remotes that failed\n\
            \\t\t       group    -- shows remotes within the specified\n\
            \\t\t                   group heirarchy"
            -- KWQ: show numbers?  How to see actual results? show details?
            True
            []
            [Asker "Filter? " (Right . T.unpack) (return . Right)]
            showFilteredWorkItems

cmd_clear :: (WorkMsg -> IO ()) -> Command (StateT CmdLineState IO) T.Text ()
cmd_clear workReq = makeCommand "clear" ("clear"==)
                    "Clears all state and resets to initial status"
                    $ \t -> do s <- get
                               liftIO $ workReq ClearAll
                               -- s' <- liftIO $ stateEventHandler s =<< (readChan $ stateChan s)
                               -- put s'

cmd_exit = makeCommand "exit" (`elem` ["exit", "quit"])
            "Exits the application."
            $ \t -> liftIO $ putStrLn "Exiting"


cmd_select = makeCommandN "select" ("select" ==)
             "Specifies which items to select by index or group or item name."
             True
             [asker]  -- must supply at least one
             (repeat asker)  -- can supply an unlimited number
             makeSelection
    where asker = Asker "Select which items? " (Right . T.unpack) (return . Right)
          makeSelection t i = selectItems $ each i
          each = foldr ((<>) . words) []

cmd_runtest :: (WorkMsg -> IO ()) -> Command (StateT CmdLineState IO) T.Text ()
cmd_runtest workReq = makeCommand "runtest" ("runtest" ==)
           "Runs a test operation on all selected remotes"
           $ \t -> runRemoteCommand workReq ["id"]

cmd_run :: (WorkMsg -> IO ()) -> Command (StateT CmdLineState IO) T.Text ()
cmd_run workReq = makeCommand "run" ("run" ==)
           "Runs the current input operation on all selected remotes"
           $ \t -> do cmdState <- get
                      let cmd = command cmdState
                      runRemoteCommand workReq [cmd]


cmd_info :: (WorkMsg -> IO ()) -> Command (StateT CmdLineState IO) T.Text ()
cmd_info workReq = makeCommand1 "info" ("info"==)
                    "Gets detailed information (including run results) for a single item."
                    True
                    itemAsker
                    $ \t -> infoSelect workReq

itemAsker :: Applicative m => Asker m Int Int
itemAsker = typeAsker "Item number? "
            (\e -> SomeException $ GenericTypeError $
                   T.pack $ "Must specify an integer item number, not " <> show e)

cmd_setcommand :: Command (StateT CmdLineState IO) T.Text ()
cmd_setcommand = makeCommand1 "input" ("input"==)
                 "Specify the command to be run on the remote systems"
                 True asker
                 $ \t c -> modify (\s -> s { command = T.pack c })
    where asker = Asker "Input command? " (Right . T.unpack) (return . Right)


-- ----------------------------------------------------------------------
-- Operations

-- Handles the show operation.  The first argument is the "show"
-- command, and the second argument is a list of at most one entry
-- specifying what type of item(s) are to be shown.
showFilteredWorkItems :: T.Text -> [String] -> StateT CmdLineState IO ()
showFilteredWorkItems t f =
    let stateFilter state = null f ||
                            case head f of
                              "results" -> state /= NoWork
                              "failed" -> state == WorkFailed
                              _ -> True
        groupFilter grpPrefix = null f ||
                                case head f of
                                  "results" -> True
                                  "failed" -> True
                                  "selected" -> True
                                  x -> matchGroup (T.pack x) grpPrefix
        selFilter s n = null f ||
                        case head f of
                          "selected" -> n `elem` selectedItems s
                          _ -> True

        itemInfo cmdState = mapMaybe (getInfo cmdState) $ itemRange cmdState

        getInfo cmdState n =
            let s = getState cmdState n
                pfx = getPrefix cmdState n
                ident = "#" <> show n <> ":: " <> selmark <> " "
                selmark = if n `elem` selectedItems cmdState then "**" else "  "
                inf = T.unpack $ info cmdState pfx n s
            in if stateFilter s && groupFilter pfx && selFilter cmdState n
               then Just $ ident <> show s <> "\t" <> inf
               else Nothing

        info cmdState pfx id state = pfx <> itemDesc cmdState id state

    in do cmdState <- get
          liftIO $ mapM_ putStrLn $ itemInfo cmdState

-- Called to update the current selection list; the item(s) to select
-- are specified in the first argument and can be an item number, a
-- group/subgroup sub-match, or an item name.  The first argument may
-- also specify "none" to clear all previously selected items..
selectItems :: [String] -> StateT CmdLineState IO ()
selectItems itemList =  -- KWQ None
    let maxItem = numItems . workItems
        inpToIds s y = case reads y of
                         [(num, "")] -> if num < maxItem s && num >= 0
                                        then [Right num]
                                        else [Left $ "Ignoring " <> show num <>
                                             "; not in the valid range 0--" <> show (maxItem s)]
                         _ -> wantSomething y $ concat [ itemsMatchingGroup s $ T.pack y
                                                       , itemsMatchingName s $ T.pack y
                                                       ]
        wantSomething y l = if null l
                            then [Left $ "No group or item matches " <> show y <> "; ignoring"]
                            else l
        itemsMatchingGroup st8 grp = map Right $ filter (matchGroup grp . getPrefix st8) $ itemRange st8
        itemsMatchingName st8 nm = map Right $ filter (nameMatch st8 nm) $ itemRange st8
        -- is numItems (workItems st8) the same as numEntries (workItems st8)?
        nameMatch s nm n = nm `T.isPrefixOf` itemDesc s n NoWork
        cvtItems s l = S.unions $ map (S.fromList . inpToIds s) l
        newItems  = S.fromList . rights . S.toList
        errs = lefts . S.toList
    in do cmdState <- get
          let cI = cvtItems cmdState itemList
          liftIO $ mapM_ (putStrLn . ("Warning: " <>)) $ errs cI
          put $ cmdState { selectedItems = selectedItems cmdState <> newItems cI }
          unless (null $ errs cI) $ liftIO $ putStrLn ""


runRemoteCommand workReq cmd =
    do cmdState <- get  -- KWQ?
       liftIO $ workReq $ StartRun cmd $ S.toList $ selectedItems cmdState
       processUntilDone
       liftIO $ putStrLn ""

processUntilDone = do s <- get
                      ev <- liftIO $ readChan $ stateChan s
                      put =<< liftIO (stateEventHandler s ev)
                      unless (isEndEvent ev) processUntilDone
    where isEndEvent EndOfInformation = True
          isEndEvent _ = False

infoSelect :: (WorkMsg -> IO ()) -> Int -> StateT CmdLineState IO ()
infoSelect workReq n = do liftIO $ workReq $ ShowSelInfo n
                          processUntilDone
                          liftIO $ putStrLn ""