{-# LANGUAGE CPP #-}
module Web where

import Control.Exception.Base
import Control.Monad.Reader

import qualified Data.ByteString.Lazy as Bsl
import qualified Data.Text.Encoding as T
import qualified Data.Map.Strict as Map
import qualified Data.Text as T

import Elab.Eval (zonkIO, force)
import Elab.Monad
import Elab

import Foreign

import Presyntax.Presyntax
import Presyntax.Parser
import Presyntax.Lexer

import Syntax.Pretty
import Syntax

#ifdef ASTERIUS
import Asterius.Types
import Asterius.Aeson
#endif

parseFromString :: String -> IO (StablePtr [Statement])
parseFromString str = do
  case runAlex (Bsl.fromStrict (T.encodeUtf8 inp)) parseProg of
    Right e -> newStablePtr e
    Left e -> throwIO (ErrorCall e)
  where
    inp = T.pack str

newEnvironment :: IO (StablePtr ElabEnv)
newEnvironment = newStablePtr =<< emptyEnv

typeCheckProgram :: StablePtr ElabEnv -> StablePtr [Statement] -> IO (StablePtr ElabEnv)
typeCheckProgram envP prog =
  do
    prog <- deRefStablePtr prog
    env <- runElab (go prog) =<< deRefStablePtr envP
    newStablePtr env
  where
    go prog = checkProgram prog ask

getTypeByName :: String -> StablePtr ElabEnv -> IO (StablePtr Value)
getTypeByName str env = do
  env <- deRefStablePtr env
  case Map.lookup (T.pack str) (nameMap env) of
    Just nm -> newStablePtr (fst (getEnv env Map.! nm))
    Nothing -> throwIO (NotInScope (Bound (T.pack str) 0))

getValueByName :: String -> StablePtr ElabEnv -> IO (StablePtr Value)
getValueByName str env = do
  env <- deRefStablePtr env
  case Map.lookup (T.pack str) (nameMap env) of
    Just nm -> newStablePtr (snd (getEnv env Map.! nm))
    Nothing -> throwIO (NotInScope (Bound (T.pack str) 0))

classifyValue :: StablePtr Value -> IO String
classifyValue val = do
  t <- deRefStablePtr val
  pure $ case force t of
    VNe (HData pathcs _) _
      | pathcs -> "data.higher"
      | otherwise -> "data"
    VNe (HCon _ _) _ -> "constr"
    _ -> "other"

classifyValueByName :: String -> StablePtr ElabEnv -> IO String
classifyValueByName str env = do
  env <- deRefStablePtr env
  case Map.lookup (T.pack str) (nameMap env) of
    Just nm -> 
      pure $ case force (snd (getEnv env Map.! nm)) of
        VNe (HData pathcs _) _
          | pathcs -> "constr.data.higher"
          | otherwise -> "constr.data"
        VNe HPCon{} _ -> "constr.higher"
        VNe HCon{} _ -> "constr"
        _ -> "other"
    Nothing -> throwIO $ NotInScope (Bound (T.pack str) 0)

findDefinition :: String -> StablePtr ElabEnv -> IO (Maybe (Posn, Posn))
findDefinition str env = do
  env <- deRefStablePtr env
  case Map.lookup (T.pack str) (nameMap env) of
    Just nm -> pure $ Map.lookup nm (whereBound env)
    Nothing -> throwIO $ NotInScope (Bound (T.pack str) 0)

zonkAndShowType :: StablePtr Value -> IO String
zonkAndShowType val = do
  val <- deRefStablePtr val
  val <- zonkIO val
  let str = show . prettyTm . quote $ val
  pure str

freeHaskellValue :: StablePtr a -> IO ()
freeHaskellValue = freeStablePtr

#ifdef ASTERIUS

parseFromStringJs :: JSString -> IO (StablePtr [Statement])
parseFromStringJs = parseFromString . fromJSString

getTypeByNameJs :: JSString -> StablePtr ElabEnv -> IO (StablePtr Value)
getTypeByNameJs str env = getTypeByName (fromJSString str) env

getValueByNameJs :: JSString -> StablePtr ElabEnv -> IO (StablePtr Value)
getValueByNameJs str env = getValueByName (fromJSString str) env

zonkAndShowTypeJs :: StablePtr Value -> IO JSString
zonkAndShowTypeJs = fmap toJSString . zonkAndShowType

classifyValueByNameJs :: JSString -> StablePtr ElabEnv -> IO JSString
classifyValueByNameJs str env = toJSString <$> classifyValueByName (fromJSString str) env

findDefinitionJs :: JSString -> StablePtr ElabEnv -> IO JSVal
findDefinitionJs str env = jsonToJSVal <$> findDefinition (fromJSString str) env

foreign export javascript parseFromStringJs     :: JSString -> IO (StablePtr [Statement])
foreign export javascript getTypeByNameJs       :: JSString -> StablePtr ElabEnv -> IO (StablePtr Value)
foreign export javascript getValueByNameJs      :: JSString -> StablePtr ElabEnv -> IO (StablePtr Value)
foreign export javascript classifyValueByNameJs :: JSString -> StablePtr ElabEnv -> IO JSString
foreign export javascript newEnvironment        :: IO (StablePtr ElabEnv)
foreign export javascript typeCheckProgram      :: StablePtr ElabEnv -> StablePtr [Statement] -> IO (StablePtr ElabEnv)
foreign export javascript zonkAndShowTypeJs     :: StablePtr Value -> IO JSString
foreign export javascript freeHaskellValue      :: StablePtr Value -> IO ()
foreign export javascript findDefinitionJs      :: JSString -> StablePtr ElabEnv -> IO JSVal

#endif