{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ExtendedDefaultRules       #-}
{-# LANGUAGE CPP                        #-}
module Game.Hanabi.Client(client, Game.Hanabi.Msg.Options(..), Game.Hanabi.Msg.defaultOptions, mkDS) where

import Game.Hanabi hiding (main, rule)
import qualified Game.Hanabi(rule)
import Game.Hanabi.Msg

import           Data.Aeson   hiding (Success)
import           GHC.Generics hiding (K1, from)
import           Data.Bool
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Data.Maybe(fromJust, isNothing)
import Data.List(intersperse)

import           Miso         hiding (Fail)
import           Miso.String  (MisoString)
import qualified Miso.String  as S

#ifdef IOS
import Language.Javascript.JSaddle.WKWebView as JSaddle

runApp :: JSM () -> IO ()
runApp = JSaddle.run
#else
import Language.Javascript.JSaddle.Warp as JSaddle

runApp :: JSM () -> IO ()
runApp = JSaddle.run 8080 -- 8720
#endif

-- Miso's implementation of WebSockets uses global IORef.
-- https://github.com/dmjio/miso/blob/master/frontend-src/Miso/Subscription/WebSocket.hs

client :: Game.Hanabi.Msg.Options -> IO ()
client options = runApp $ startApp App{
    model  = Model{tboxval = Message "available", players = ["via WebSocket"], from = Just 0, rule = defaultRule, received = [], fullHistory = False},
    update = updateModel,
    view   = appView strNames $ version options,
    subs   = [ websocketSub uri protocols HandleWebSocket ],
    events = defaultEvents,
    initialAction = Id,
    -- initialAction = SendMessage $ Message "available", -- Seemingly sending as initialAction does not work, even if connect is executed before send.
    mountPoint = Nothing}
  where strNames = "via WebSocket" : [ S.pack name | (name, _) <- strategies options ]
#ifdef URI
uri = URL URI
#else
-- uri = URL "ws://133.54.228.39:8720"
uri = URL "ws://localhost:8720"
#endif
protocols = Protocols []

{- At last, I chose to hide the history by default.
lenHistory = 400
-- A better approach might be
-- 1. to send the history to a separate frame after the endgame
-- 2. to memoize renderMsg
-- Also, `observe' should not send to the current player.
-}
updateModel :: Action -> Model -> Effect Action Model
updateModel (HandleWebSocket (WebSocketMessage (Message m))) model
  = noEff model{ received = {- take lenHistory $ -} decodeMsg m : received model }
updateModel (SendMessage msg) model = model{fullHistory=False} <# (-- connect uri protocols >>
                                                send msg >> return Id)
updateModel (UpdateTBoxVal m) model = noEff model{ tboxval = Message m }
updateModel (From mbn)        model = noEff model{from = mbn}
updateModel IncreasePlayers   model = noEff model{players = take 9 $ "via WebSocket" : players model}
updateModel DecreasePlayers   model = noEff model{players = case players model of {n:ns@(_:_) -> ns; ns -> ns}}
updateModel (UpdatePlayer ix pl) model = noEff model{players = snd $ replaceNth ix pl $ players model}
updateModel (UpdateRule r)    model | isRuleValid r = noEff model{rule=r}
updateModel Toggle            model = noEff model{fullHistory = not $ fullHistory model}
#ifdef DEBUG
updateModel (HandleWebSocket act) model = noEff model{received = Str (show act) : received model }
#endif
updateModel _ model = noEff model

instance ToJSON Message
instance FromJSON Message

newtype Message = Message MisoString
  deriving (Eq, Show, Generic)

data Action
  = HandleWebSocket (WebSocket Message)
  | SendMessage Message
  | UpdateTBoxVal MisoString
  | From (Maybe Int)
  | IncreasePlayers
  | DecreasePlayers
  | UpdatePlayer Int MisoString
  | UpdateRule Rule
  | Toggle
  | Id

data Model = Model {
    tboxval :: Message
  , players :: [MisoString] -- REVERSED list of players other than this client
  , from :: Maybe Int
  , rule :: Rule
  , received :: [Msg]
  , fullHistory :: Bool
  } deriving (Show, Eq)

lenShownHistory = 10
appView :: [MisoString] -> String -> Model -> View Action
appView strategies versionInfo mdl@Model{..} = div_ [] [
   input_  [ type_ "text", placeholder_ "You can also use your keyboard.", size_ "25", onInput UpdateTBoxVal, onEnter (SendMessage tboxval) ]
 , button_ [ onClick (SendMessage tboxval) ] [ text (S.pack "Send to the server") ]
-- x , span_ [style_ $ M.fromList [("font-size","10px")]] [text $ S.pack "(Use this line if you prefer the keyboard interface.)"]
 , span_ [style_ $ M.fromList [("font-size","10px"), ("float","right")]] [text $ S.pack $ "hanabi-dealer client "++versionInfo]
-- , hr_ []
 , div_ [style_ $ M.fromList [("clear","both")]] ((if fullHistory then id else take lenShownHistory) $ map (renderMsg strategies verbose mdl) received)
 , div_ [] $ if null $ drop lenShownHistory received then [] else [
     hr_ []
   , input_ [ type_ "checkbox", id_ "showhist", onClick Toggle, checked_ fullHistory]
   , label_ [for_ "showhist"] [text "Show full history"]
   ]
 ]

onEnter :: Action -> Attribute Action
onEnter action = onKeyDown $ bool Id action . (== KeyCode 13)
{-
#ifdef AESON
prettyDecode :: MisoString -> MisoString
prettyDecode str = case decode $ S.fromMisoString str of Nothing  -> str
                                                         Just msg -> S.toMisoString $ encode $ prettyMsg verbose msg
#else
prettyDecode :: MisoString -> MisoString
prettyDecode str = case reads $ S.fromMisoString str of []  -> str
                                                        [(msg,_)] -> S.toMisoString $ prettyMsg verbose msg
#endif
render :: MisoString -> View Action
render str = case decode str' of Nothing  -> text $ S.fromMisoString str
                                 Just msg -> renderMsg verbose msg
   where str' = S.fromMisoString str
-}
decodeMsg :: MisoString -> Msg
#ifdef AESON
decodeMsg str = case decode $ S.fromMisoString str of Nothing  -> Str $ S.fromMisoString str
                                                      Just msg -> msg
#else
decodeMsg str = case reads $ S.fromMisoString str of []  -> Str $ S.fromMisoString str
                                                     [(msg,_)] -> msg
#endif

renderMsg :: [MisoString] -> Verbosity -> Model -> Msg -> View Action
renderMsg _ _    _ (Str xs)             = div_ [] [hr_ [], pre_ [] [ text $ S.pack xs ]]
renderMsg _ verb _ (WhatsUp name ps ms) = renderWhatsUp  verb name ps ms
renderMsg _ verb _ (WhatsUp1     p  m)  = renderWhatsUp1 verb p m
renderMsg _ _    _ (PrettyEndGame Nothing)     = pre_ [] [ text $ S.pack $ prettyMbEndGame Nothing]
renderMsg _ _    _ (PrettyEndGame (Just tup))  = renderEndGame tup -- pre_ [] [ text $ S.pack $ prettyEndGame tup]
renderMsg strategies _    mdl (PrettyAvailable games)
  = div_ [style_ $ M.fromList [("overflow","auto")]] [
      hr_ [],
      table_ [style_ $ M.fromList [("border-style","solid"), ("clear","both"), ("float","right")]] $
           caption_ [] [text $ S.pack "Available games", button_ [onClick $ SendMessage $ Message "available"] [text $ S.pack "refresh"]] :
           tr_ [] [ th_ [solid] [text $ S.pack str] | str <- ["Game ID", "available", "total"] ] :
           map renderAvailable games,
      div_ [] [
--             table_ [] $ caption_ [textProp "text-align" "left", textProp "margin-left" "auto"] [ -- Seemingly these styles do not work.
             text "Player list",
             button_ [onClick IncreasePlayers] [text $ S.pack "+"],
             button_ [onClick DecreasePlayers] [text $ S.pack "-"],
             input_ [type_ "radio", id_ "shuffle", onClick (From Nothing), checked_ $ from mdl == Nothing],
             label_ [for_ "shuffle"] [text "shuffle before the game"],
-- x                                   ] :
             table_ [] $ [ tr_ [] [td_ [solid] [x], td_ [] [input_ [type_ "radio", id_ iD, onClick (From $ Just n), checked_ $ from mdl == Just n],
                                                            label_ [for_ iD] [text "Turn 0"]]]
                         | (n,x) <- zip [0..] $ text "You" : reverse (zipWith (renderPlayer strategies) [0..] (players mdl))
                         , let iD = S.pack $ "radio"++show n ]
-- x                       ++ [tr_ [] [td_ [] [], td_ [] [input_ [type_ "radio", id_ "shuffle", onClick (From Nothing), checked_ $ from mdl == Nothing],
--                                                        label_ [for_ "shuffle"] [text "shuffle the player list before the game"]]]]
                     ,
--             div_ [] [text $ "Rules"],
--             div_ [] [input_ [type_ "text", onInput (UpdateRule . head . (++[rule mdl]) . map fst . reads . S.unpack), value_ $ S.pack $ show $ rule mdl, style_ $ M.fromList [("width","70%")]]],

             let mkTR label updater access = tr_ [] [
                          td_ [] [text label],
                          td_ [] [
                             input_ [type_ "text", onInput (UpdateRule . updater . head . (++[access $ rule mdl]) . map fst . reads . S.unpack), value_ $ S.pack $ show $ access $ rule mdl]
                            ]
                        ] in
               table_ [] [
                   caption_ [] [text "Rules"],
                   mkTR "Number of lives"                               (\n -> (rule mdl){numBlackTokens=n}) numBlackTokens,
                   mkTR "Number of colors"                              (\n -> (rule mdl){numColors=n})      numColors,
                   mkTR "Continue the game after the pile is exhausted" (\n -> (rule mdl){prolong=n})        prolong,
                   mkTR "numMulticolors"                                (\n -> (rule mdl){numMulticolors=n}) numMulticolors,
                   mkTR "funPlayerHand"                                 (\n -> (rule mdl){funPlayerHand=n})  funPlayerHand
                 ],

             button_ [onClick $ SendMessage $ Message $ S.pack $ (case from mdl of Just n -> "from " ++ shows n " "
                                                                                   Nothing-> "shuffle ") ++ show (rule mdl) ++ concat (intersperse "," $ map S.unpack $ reverse $ players mdl)] [text $ S.pack "create a game"]
      ]
   ]
renderPlayer :: [MisoString] -> Int -> MisoString -> View Action
--renderPlayer _ i p = text p
renderPlayer strategies i p = select_ [onChange $ UpdatePlayer i] [ option_ [value_ p', selected_ $ p==p'] [text p'] | p' <- strategies ]


renderAvailable (gameid, (missing, total))
  = tr_ [onClick $ SendMessage $ Message $ S.pack $ "attend "++show gameid] [ td_ [solid] [text $ S.pack str] | str <- [show gameid, show missing, show total] ]
solid = style_ $ M.fromList [("border-style","solid")]

renderWhatsUp verb name views@(v:_) moves = div_ [] [
  hr_ [],
  text $ S.pack "Your turn.",
  hr_ [],
  renderRecentEvents (publicView v) ithPlayer views moves,
  hr_ [],
  text $ S.pack $ "Algorithm: " ++ name,
  renderPV verb v
 ]
renderWhatsUp1 :: Verbosity -> PrivateView -> Move -> View Action
renderWhatsUp1 verb v m = div_ [style_ $ M.fromList [("background-color","#555555"),("color","#000000")]] [
  hr_ [],
  renderTrial (publicView v) (const "") undefined v m,
  hr_ [],
  renderPV verb v
 ]

renderEndGame :: (EndGame, [State], [Move]) -> View Action
renderEndGame (eg,sts@(st:_),mvs)
  = div_ [] [
         hr_ [],
         renderRecentEvents (publicState st) ithPlayerFromTheLast (map Game.Hanabi.view sts) mvs,
         hr_ [],
         h1_ [style_ $ M.fromList [("background-color","#FF0000"),("color","#000000")]] [text $ S.pack $ show eg],
         hr_ [],
         renderSt ithPlayerFromTheLast st,
         hr_ []
         ]

renderTrial :: PublicInfo -> (Int -> String) -> Int -> PrivateView -> Move -> View Action
renderTrial pub ithP i v m =  div_ [] [
  text $ S.pack $ ithP i ++ " move: " ++ {- replicate (length (ithP 2) - length (ithP i)) ' ' ++ -} show m
  , case result $ publicView v of Discard c -> showResults c ", which revealed "
                                  Success c -> showResults c ", which succeeded revealing "
                                  Fail    c -> showResults c ", which failed revealing "
                                  _         -> text $ S.pack ""
  ]
  where showResults c xs = span_ [] [
            xs
--          , renderHand' verbose pub [Just c] [(Nothing,Nothing)]
          , renderCardInline verbose pub c
          , text $ S.pack "."
          ]
renderPI pub
{- This was too verbose
  = let
      showDeck 0 = "no card at the deck (the game will end in " ++ shows (fromJust $ deadline pub) " turn(s)), "
      showDeck 1 = "1 card at the deck, "
      showDeck n = shows n " cards at the deck, "
    in  "Turn "++ shows (turn pub) ": " ++ showDeck (pileNum pub) ++ shows (lives pub) " live(s) left, " ++ shows (hintTokens pub) " hint tokens;\n\n"
-}
  = let
      showDeck 0 = if prolong $ Game.Hanabi.rule $ gameSpec pub then "Deck: 0,  " else "Deck: 0 (" ++ shows (fromJust $ deadline pub) " turn(s) left),  "
      showDeck 1 = "Deck: 1,  "
      showDeck n = "Deck: " ++ shows n ",  "
    in div_ [] [
      text $ S.pack $ "Turn: "++ shows (turn pub) ",  " ++ showDeck (pileNum pub) ++ "Lives: " ++ shows (lives pub) ",  Hints: " ++ shows (hintTokens pub) ";",

      div_ [] [
        text $ S.pack $ "played:",
        span_ [] [ span_ [] $ text (S.pack "|") : [ renderCardInline verbose pub $ C c k | k <- [K1 .. playedMax]] | c <- [White .. Multicolor], Just playedMax <- [IM.lookup (fromEnum c) (played pub)] ],
        text $ S.pack "|"
      ],

      div_ [] [
        text $ S.pack $ "dropped: ",
        span_ [] [ span_ [] $ text (S.pack "|") : (replicate n $ renderCardInline verbose pub $ intToCard ci) | (ci,n) <- IM.toList $ discarded pub ],
        text $ S.pack "|"
      ]
     ]
renderCardInline v pub c = span_ [style_ $ M.fromList [("width","30px"),("color", colorStr $ Just $ color c),("background-color","#000000")]] [cardStr verbose pub 0 (Just c) (Nothing,Nothing)]

renderRecentEvents :: PublicInfo -> (Int -> Int -> String) -> [PrivateView] -> [Move] -> View Action
renderRecentEvents pub ithP vs@(v:_) ms = div_ [] $ reverse $ zipWith3 (renderTrial pub $ ithP nump) [pred nump, nump-2..0] vs ms
   where nump = numPlayers $ gameSpec $ publicView v


renderPV :: Verbosity -> PrivateView -> View Action
renderPV v pv@PV{publicView=pub} = div_ [] [
  renderPI pub,
  div_ [] (
--      div_ [] [text $ S.pack $ "My hand:"] :
--      renderCards v pub [ Nothing | _ <- myHand] myHand :
      renderHand v pv (const "My") 0 [ Nothing | _ <- myHand] myHand :
--                                              ++ concat [ '+':shows d "-" | d <- [0 .. pred $ length myHand] ]
      (zipWith3 (renderHand v pv (ithPlayer $ numPlayers $ gameSpec pub)) [1..] (map (map Just) $ handsPV pv) $ tail $ givenHints pub)
    )
  ]
  where myHand = head (givenHints pub)

renderSt ithP st@St{publicState=pub} = div_ [] $
  renderPI pub :
  zipWith3 (renderHand verbose (Game.Hanabi.view st) (ithP $ numPlayers $ gameSpec pub)) [0..] (map (map Just) $ hands st) (givenHints pub)

renderHand :: Verbosity -> PrivateView -> (Int->String) -> Int -> [Maybe Card] -> [Marks] -> View Action
renderHand v pv ithPnumP i mbcards hl = div_ [] [
  div_ [] [text $ S.pack $ ithPnumP i ++ " hand:"],
   renderHand' v pv i mbcards hl
--  renderCards v pub (map Just cards) hl
  ]
renderHand' :: Verbosity -> PrivateView -> Int -> [Maybe Card] -> [Marks] -> View Action
renderHand' v pv pli mbcards hl = 
   table_ [style_ $ M.fromList [("border-color","#FFFFFF"), ("border-width","medium")]] [tr_ [style_ $ M.fromList [("background-color","#000000"), ("height","48px")]] (zipWith3 (renderCard v pv pli hl) [0..] mbcards hl)]

renderCard :: Verbosity -> PrivateView -> Int -> [Marks] -> Index -> Maybe Card -> Marks -> View Action
renderCard v pv pli hl i mbc tup@(mc,mk) = td_ [style_ $ M.fromList [("width","36px"),
                                                                   ("color", colorStr $ fmap color mbc)]] [
     maybe (button_ [ onClick (SendMessage $ Message $ S.pack $ 'p':show i) ] [ text (S.pack "play") ]) (const $ span_[][]) mbc,
     div_ [] [
        cardStr v pub pli mbc tup
     ],
     div_ [myStyle] [text $ S.pack $ if markHints v then maybe '_' (head . show) mc : [maybe '_' (head . show . fromEnum) mk] else "__" ],
     maybe (button_ [ onClick (SendMessage $ Message $ S.pack $ 'd':show i) ] [ text (S.pack "drop") ]) (const $ span_[][]) mbc
  ] where
          pub = publicView pv
          myStyle = style_ $ M.fromList [ ("background-color",if markChops v && i `elem` map fst (concat $ take 1 $ chopss pub hl) then "#888888" else "#000000"),
                                          ("font-weight", if markObviouslyUseless v && isObviouslyUseless pub tup then "100" else "normal"),
                                          ("font-style",  if markObviouslyPlayable v && (if isNothing mbc then isObviouslyPlayable pv else isMoreObviouslyPlayable pub) tup then "oblique" else "normal")]
{-
renderCards :: Verbosity -> PublicInfo -> [Maybe Card] -> [Marks] -> View Action
renderCards v pub mbcs tups = table_ [style_ $ M.fromList [("border-color","#FFFFFF"),("border-width","medium")]] [
  tr_ [style_ $ M.fromList [("background-color","#000000")]]
     [
       td_ [style_ $ M.fromList [("color", colorStr $ fmap color mbc)]] [
        cardStr v pub mbc tup
        ]
     | (mbc,tup) <- zip mbcs tups
     ],
  tr_ [style_ $ M.fromList [("background-color","#000000")]]
     [
       td_ [style_ $ M.fromList [("color", colorStr $ fmap color mbc)]] [
          text $ S.pack $ if markHints v then maybe ' ' (head . show) mc : [maybe ' ' (head . show . fromEnum) mk] else ""
       ]
     | (mbc,(mc,mk)) <- zip mbcs tups
     ]
  ]
-}
-- Not sure which style is better.
#ifdef BUTTONSONCARDS
cardStr v pub pli mbc tup = case mbc of
          Nothing -> span_ [] [text $ S.pack "??"]
          Just c  -> span_ [] [
--                                    text $ S.pack $ show c
                                    button_ [onClick (SendMessage $ Message $ S.pack $ shows pli $ take 1 $ show $ color c), style] [text $ S.pack $ take 1 $ show $ color c],
                                    button_ [onClick (SendMessage $ Message $ S.pack $ shows pli $ show $ fromEnum $ number c), style][text $ S.pack $ show $ fromEnum $ number c]
                             ]
                     where style = style_ $ M.fromList [
                              ("font-weight", if markUseless v && isUseless pub c then "100"
                                              else if warnCritical v && tup==(Nothing,Nothing) && isCritical pub c then "bold" else "normal"),
                              ("font-style",  if markPlayable v && isPlayable pub c then "oblique" else "normal"), ("background-color","#000000"),("color", colorStr $ fmap color mbc)]
#else
cardStr v pub pli mbc tup = case mbc of
          Nothing -> span_ [] [text $ S.pack "??"]
          Just c  -> span_ [style] [
--                                    text $ S.pack $ show c
                                    span_ [style_ $ M.fromList [("font-size","20px")],
                                              onClick (SendMessage $ Message $ S.pack $ shows pli $ take 1 $ show $ color c)] [text $ S.pack $ take 1 $ show $ color c],
                                    span_ [style_ $ M.fromList [("font-size","20px")],
                                              onClick (SendMessage $ Message $ S.pack $ shows pli $ show $ fromEnum $ number c)][text $ S.pack $ show $ fromEnum $ number c]
                             ]
                     where style = style_ $ M.fromList [-- ("width","30px"),
                              ("font-weight", if markUseless v && isUseless pub c then "100"
                                              else if warnCritical v && tup==(Nothing,Nothing) && isCritical pub c then "bold" else "normal"),
                              ("font-style",  if markPlayable v && isPlayable pub c then "oblique" else "normal")]
#endif
colorStr Nothing       = "#00FFFF"
colorStr (Just White)  = "#FFFFFF"
colorStr (Just Yellow) = "#FFFF00"
colorStr (Just Red)    = "#FF4444"
colorStr (Just Green)  = "#44FF44"
colorStr (Just Blue)   = "#8888FF"
colorStr (Just Multicolor) = "#FF00FF"