Utility.hs

{-# LANGUAGE LambdaCase #-}

module Haskell.DAP.GHCi.Utility where

import qualified GHC
import qualified GHCi.UI.Monad as G
import Outputable
import Exception

import qualified Data.Char as CH
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as T
import qualified Data.Text as T
import qualified Data.List as L
import qualified Text.Read as R
import Data.Maybe
import Data.Word

import Control.Monad.IO.Class
import Control.Concurrent

import Haskell.DAP.GHCi.Constant
import Haskell.DAP.GHCi.Type

import qualified GHCi.DAP.IFData as D

-- |
--
_SLASH :: Char
_SLASH = '/'


-- |
--
_BACK_SLASH :: Char
_BACK_SLASH = '\\'


-- |
--
_SPACES :: [Char]
_SPACES = [' ', '\n', '\t']


-- |
--
lstrip, rstrip, strip :: String -> String
lstrip = dropWhile (flip elem _SPACES)
rstrip = reverse . lstrip . reverse
strip  = lstrip . rstrip


-- |
--
toLower :: String -> String
toLower = map CH.toLower


-- |
--
toUpper :: String -> String
toUpper = map CH.toUpper


-- |
--
win2unixSlash :: String -> String
win2unixSlash = map (\c -> if c == _BACK_SLASH then _SLASH else c)


-- |
--
unix2winSlash :: String -> String
unix2winSlash = map (\c -> if c == _SLASH then _BACK_SLASH else c)


-- |
--   normalized path
--
nzPath :: FilePath -> FilePath
nzPath = drive2lower . win2unixSlash


-- |
--  to lowercase Windows drive letter 
-- 
drive2lower :: FilePath -> FilePath
drive2lower (x : ':' : xs) = CH.toLower x : ':' : xs
drive2lower xs = xs


------------------------------------------------------------------------------------------------
--  DAP Utility
------------------------------------------------------------------------------------------------

-- |
--
--   phoityne -> haskell-dap
--   RequestArgument is encoded. decode to [Word8]
--
readDAP :: Read a => String -> Either String a
readDAP argsStr = case R.readEither argsStr :: Either String [Word8] of
  Left err -> Left $ "read [Word8] failed. " ++ err ++ " : " ++ argsStr
  Right bs -> case R.readEither (toStr bs) of
    Left err -> Left $ "read response body failed. " ++ err ++ " : " ++  (toStr bs)
    Right a  -> Right a 
  where
    toStr = T.unpack . T.decodeUtf8 . BS.pack


-- |
--
--   haskell-dap -> phoityne
--   Just show ResponseBody. no need to encode to [Word8]
--
showDAP :: Show a => a -> String
showDAP = show


-- |
--
printDAP :: Show a => a -> G.GHCi ()
printDAP dat = do
  let outStr = _DAP_HEADER ++ showDAP dat

  liftIO $ putStrLn outStr

-- |
--
printOutputEventDAP ::  (Either String D.OutputEventBody) -> G.GHCi ()
printOutputEventDAP dat = do
  let outStr = _DAP_HEADER_OUTPUT_EVENT ++ showDAP dat

  liftIO $ putStrLn outStr


-- |
--
clearTmpDAPContext :: G.GHCi ()
clearTmpDAPContext = do
  mvarCtx <- G.dapContextGHCiState  <$> G.getGHCiState 

  ctx <- liftIO $ takeMVar mvarCtx
  liftIO $ putMVar mvarCtx ctx{
      traceCmdExecResultDAPContext   = []
    , doContinueExecResultDAPContext = []
    , runStmtDeclExceptionDAPContext = []
    }


-- |
--
isExceptionResume :: GHC.Resume -> Bool
isExceptionResume (GHC.Resume{GHC.resumeBreakInfo = a}) = isNothing a


-- |
--
parseNameErrorHandler :: SomeException -> G.GHCi [GHC.Name]
parseNameErrorHandler e = liftIO $ print e >> return []


-- |
--
showTermErrorHandler :: SomeException -> G.GHCi SDoc
showTermErrorHandler e = return $ text $ show e

-- |
--
getNameTypeValue :: String -> (String, String, String)
getNameTypeValue str = (strip nameStr, strip typeStr, strip valueStr)
  where
    nameStr  = head $ words str
    typeStr  = unwords $ takeWhile ((/=)"=") $ tail $ tail $ words str 
    valueStr = unwords $ tail $ dropWhile ((/=)"=") $ words str 

-- |
--
getRunStmtSourceError :: G.GHCi String
getRunStmtSourceError = do
  mvarCtx <- G.dapContextGHCiState <$> G.getGHCiState 

  ctx <- liftIO $ readMVar mvarCtx
  let errs = runStmtDeclExceptionDAPContext ctx
      msgs = "[DAP][ERROR] error occurred while runStmt." 
            : map show errs

  return $ L.intercalate "\n" msgs