Utility.hs

module Haskell.DAP.GHCi.Utility where

import qualified Data.Char as CH

import qualified GHC

import qualified GHCi.UI.Monad as G

import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as T
import qualified Data.Text as T
import qualified Text.Read as R
import Data.Word

import Control.Monad.IO.Class
import System.Console.Haskeline

import Haskell.DAP.GHCi.Constant
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
------------------------------------------------------------------------------------------------

-- |
--
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


-- |
--
showDAP :: Show a => a -> String
showDAP = show . BS.unpack . T.encodeUtf8 . T.pack . show


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

  liftIO $ putStrLn outStr


-- |
--
showStoppedEventBody :: Maybe GHC.ExecResult -> G.GHCi ()
showStoppedEventBody Nothing = return ()
showStoppedEventBody (Just (GHC.ExecComplete { GHC.execResult = Right _ })) = do
  let body = Right D.defaultStoppedEventBody {
             D.reasonStoppedEventBody = "complete"
           } :: Either String D.StoppedEventBody
      outStr = _DAP_HEADER ++ showDAP body
  liftIO $ putStrLn outStr
  
showStoppedEventBody (Just (GHC.ExecComplete { GHC.execResult = Left (SomeException e)})) = do
  let body = Right D.defaultStoppedEventBody {
             D.reasonStoppedEventBody = "exception"
           , D.descriptionStoppedEventBody = show e
           } :: Either String D.StoppedEventBody
      outStr = _DAP_HEADER ++ showDAP body
  liftIO $ putStrLn outStr

showStoppedEventBody (Just GHC.ExecBreak{}) = do
  let body = Right D.defaultStoppedEventBody {
             D.reasonStoppedEventBody = "step"
           } :: Either String D.StoppedEventBody
      outStr = _DAP_HEADER ++ showDAP body
  liftIO $ putStrLn outStr