InlayHints.hs

module Zwirn.Language.LSP.InlayHints where

import Control.Concurrent (readMVar)
import Control.Monad.RWS (gets, liftIO)
import qualified Data.Map as Map
import Data.Maybe (catMaybes, mapMaybe)
import Data.Text as T (Text, filter, unpack)
import Zwirn.Language (Syntax (..), Term (..), catchMany, parseBlock)
import Zwirn.Language.Compiler (CI, CompilerOutput (..), Environment (..), filterErrors, noSolo, runBlocks, runCommand)
import Zwirn.Language.Location (Located (..), Position (..), RealSrcLoc (..), SrcLoc (..))
import Zwirn.Stream.Target (Targeted (..))
import Zwirn.Stream.Types (Identifier (..), PlayMap, PlayState (..), Stream (..))

data Hint
  = Hint
  { hPos :: Position,
    hContent :: Text,
    hDescription :: Text
  }
  deriving (Show)

getHints :: Text -> CI [Hint]
getHints doc = do
  blocks <- runBlocks 0 doc
  ss <- concat <$> catchMany (map parseBlock blocks)
  sh <- getStreamHints ss
  ch <- getCommandHints ss
  return $ sh ++ ch

-- | inlay hints above stream actions of the form `id &: exp`, for displaying the play state of the according expression
getStreamHints :: [Syntax] -> CI [Hint]
getStreamHints ss = do
  pm <- gets (sPlayMap . tStream) >>= liftIO . readMVar
  let chans = map findStreamPattern ss
  return $ mapMaybe (resolvePlayState pm) chans

-- | returns the channel key and a positon one line above it
findStreamPattern :: Syntax -> Maybe (Identifier, Position)
findStreamPattern (Exec (Located (SrcLoc (RealSrcLoc _ ln ch _ _)) (TInfix (Located _ (TNum chan)) (Located _ "($:)") _))) = if ln <= 1 then Nothing else Just (NumID (read $ unpack chan), Position (ln - 1) ch)
findStreamPattern (Exec (Located (SrcLoc (RealSrcLoc _ ln ch _ _)) (TInfix (Located _ (TText chan)) (Located _ "($:)") _))) = if ln <= 1 then Nothing else Just (TextID $ stripText chan, Position (ln - 1) ch)
  where
    stripText = T.filter (/= '\"')
findStreamPattern _ = Nothing

lookupPlayState :: Identifier -> PlayMap -> Maybe PlayState
lookupPlayState key pm = (\(Targeted _ (x, _, _)) -> x) <$> Map.lookup key pm

resolvePlayState :: PlayMap -> Maybe (Identifier, Position) -> Maybe Hint
resolvePlayState pm mx
  | noSolo pm = do
      (key, pos) <- mx
      ps <- lookupPlayState key pm
      case ps of
        Solo -> return $ Hint pos "(solo)" "stream hint"
        Mute -> return $ Hint pos "(muted)" "stream hint"
        Normal -> return $ Hint pos "(playing)" "stream hint"
  | otherwise = do
      (key, pos) <- mx
      ps <- lookupPlayState key pm
      case ps of
        Solo -> return $ Hint pos "(solo)" "stream hint"
        Mute -> return $ Hint pos "(muted)" "stream hint"
        Normal -> return $ Hint pos "(not soloed)" "stream hint"

-- | inlay hints underneath commands to display their output
getCommandHints :: [Syntax] -> CI [Hint]
getCommandHints ss = catMaybes <$> filterErrors (map commandHint ss)

commandHint :: Syntax -> CI (Maybe Hint)
commandHint (Command (Located (SrcLoc (RealSrcLoc _ _ _ ln ch)) x)) = do
  out <- runCommand x
  case out of
    OutMessage ms -> return $ Just $ Hint (Position ln (ch + 1)) ("\n" <> ms) "command hint"
    _ -> return Nothing
commandHint _ = return Nothing