Misc.hs

module Interpreter.Lib.Misc where

import Control.Concurrent.STM (atomically, newTVarIO, writeTChan)
import Control.Concurrent.STM.TSem
import Control.Monad.IO.Class
import System.Directory
import System.Process
import System.FilePath
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as A
import qualified Data.Aeson.KeyMap as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Coerce
import Data.Map as M
import Data.Proxy
import qualified Data.Scientific as S
import Data.Text as T
import Data.Text.Encoding
import Data.Text.IO as T
import Data.Vector as V
import qualified System.IO as S
import Text.Hex (decodeHex, encodeHex)
import Text.Printf (printf)
import Text.Read (readMaybe)
import Data.Typeable

import Common
import Compiler.AST.Program
import DiffRender.DiffRender
import Interpreter.Common
import Interpreter.Interpreter
import UI.Widgets.BorderBox
import UI.Widgets.Common hiding (getSelection)
import UI.Widgets.Spade.Layout
import UI.Widgets.Spade.Button
import UI.Widgets.Spade.TextContainer
import UI.Widgets.Spade.TextLabel
import UI.Widgets.Spade.RefLabel
import UI.Widgets.Spade.Selector
import UI.Widgets.Spade.Input
import Compiler.Parser

initCharScreen :: BuiltInFnWithDoc '[]
initCharScreen _ = do
  isTerminalParams <$> getInterpretM >>= \case
    Just (_, dm) ->  do
      csInitialize dm
      -- modifyDiffRender (\dfr -> dfr { dfDebug = True })
    Nothing      -> throwErr $ CustomRTE "Unknown terminal size"
  pure Nothing

charScreenGoto :: BuiltInFnWithDoc '[ '("x", Int), '("y", Int)]
charScreenGoto ((coerce -> x) :> (coerce -> y) :> _) = do
  charScreenGoto' x y
  pure Nothing

charGetDimensions :: BuiltInFnWithDoc '[]
charGetDimensions EmptyArgs = do
  isTerminalParams <$> getInterpretM >>= \case
    Just (_, dm) ->
      pure $ Just $ ObjectValue $ M.fromList [("width", NumberValue $ NumberInt $ fromIntegral $ diW dm), ("height", NumberValue $ NumberInt $ fromIntegral $ diH dm)]
    Nothing -> throwErr $ CustomRTE "Unknown terminal size"

charScreenGoto' :: Int -> Int -> InterpretM ()
charScreenGoto' x y = csSetCursorPosition x y

charScreenGet' :: InterpretM ScreenPos
charScreenGet' = do
  isDiffRender <$> getInterpretM >>= \case
    Just dm -> pure $ dfGetCursorPosition dm
    Nothing -> throwErr $ CustomRTE "Char screen not initialized"

charScreenGet :: BuiltInFnWithDoc '[]
charScreenGet EmptyArgs = do
  sp <- charScreenGet'
  pure $ Just $ ObjectValue $ M.fromList [("x", NumberValue $ NumberInt $ fromIntegral $ sX sp), ("y", NumberValue $ NumberInt $ fromIntegral $ sY sp)]

charScreenMove :: BuiltInFnWithDoc '[ '("x", Int), '("y", Int)]
charScreenMove ((coerce -> x) :> (coerce -> y) :> _) = charScreenMove' x y >> pure Nothing

charScreenMove' :: Int -> Int -> InterpretM ()
charScreenMove' x y = do
  isDiffRender <$> getInterpretM >>= \case
    Just dm ->  modifyInterpretM (\is -> is { isDiffRender = Just $ dfSetCursorPosition (+ x) (+ y) dm })
    Nothing -> throwErr $ CustomRTE "Char screen not initialized"

charScreenPrint :: BuiltInFnWithDoc '[ '("values", Variadic)]
charScreenPrint ((coerce -> Variadic vals) :> _) = charScreenPrint' (T.concat $ toStringVal <$> vals) >> pure Nothing

charScreenPrintLn :: BuiltInFnWithDoc '[ '("values", Variadic)]
charScreenPrintLn ((coerce -> Variadic vals) :> _) = do
  charScreenClearLine'
  charScreenPrint' (T.concat $ toStringVal <$> vals)
  charScreenMove' 0 1
  pure Nothing

charScreenPrint' :: Text -> InterpretM ()
charScreenPrint' txt = csPutText (Plain txt)

charScreenInputLine :: BuiltInFnWithDoc '[ '("prompt", Text)]
charScreenInputLine ((coerce -> prompt) :> _) = (Just . StringValue) <$> (charScreenInputLine' prompt)

charScreenInputLine' :: Text -> InterpretM Text
charScreenInputLine' prompt = do
  charScreenPrint' prompt
  charScreenDraw'
  charScreenMove' (T.length prompt) 0
  readCharScreenInput >>= \case
    Nothing -> do
      charScreenGoto' 0 -1
      charScreenClearLine'
      charScreenInputLine' prompt
    Just x -> pure x

charScreenClear :: BuiltInFnWithDoc '[]
charScreenClear _ = csClear >> pure Nothing

charScreenClearLine :: BuiltInFnWithDoc '[]
charScreenClearLine EmptyArgs = charScreenClearLine' >> pure Nothing

charScreenClearLine' :: InterpretM ()
charScreenClearLine' = csClearLine

charScreenDraw :: BuiltInFnWithDoc '[]
charScreenDraw _ = charScreenDraw' >> pure Nothing

charScreenDraw' :: InterpretM ()
charScreenDraw' = do
  tp <- isTerminalParams <$> getInterpretM
  isStdoutLock <$> getInterpretM >>= \case
    Just sem -> do
      liftIO $ atomically $ waitTSem sem
      csDraw tp
      liftIO $ atomically $ signalTSem sem
    Nothing -> csDraw tp

readCharScreenInput :: InterpretM (Maybe Text)
readCharScreenInput = readInput ""
  where
    readInput ti = do
      c <- interpreterInputChar
      case c of
        '\n' -> pure $ Just $ T.reverse $ T.pack ti
        '\ESC' -> pure Nothing
        '\BS' -> readInput ti
        _ -> do
          charScreenPrint' (T.singleton c)
          charScreenMove' 1 0
          charScreenDraw'
          readInput (c:ti)

builtInInitWIdgets :: BuiltInFnWithDoc '[]
builtInInitWIdgets EmptyArgs = do
  isWidgetState <$> getInterpretM >>= \case
    Nothing -> modifyInterpretM (\is -> is { isWidgetState = Just emptyWidgetState })
    Just _ -> pass
  pure Nothing

builtInLayoutWidget :: BuiltInFnWithDoc '[ '("orientation", Text), '("child_layout", [[Double]]), '("children", [SomeWidgetRef])]
builtInLayoutWidget ((coerce -> (orientation :: Text )) :> (coerce -> (cl :: [[Double]])) :> (coerce -> children) :> EmptyArgs) = do
  layout <- layoutWidget (if orientation == "h" then Horizontal else Vertical) cl children
  pure $ Just (WidgetValue (SomeWidgetRef layout))

builtInLayoutWidgetSimple :: BuiltInFnWithDoc '[ '("orientation", Text), '("children", [SomeWidgetRef]) ]
builtInLayoutWidgetSimple ((coerce -> (orientation :: Text )) :> (coerce -> children) :>  EmptyArgs) = do
  layout <- simpleLayoutWidget (if orientation == "h" then Horizontal else Vertical) children
  pure $ Just (WidgetValue (SomeWidgetRef layout))

builtInTextContainerWidget :: BuiltInFnWithDoc '[]
builtInTextContainerWidget EmptyArgs = do
  tc <- textContainer (ScreenPos 0 0) (Dimensions 20 5)
  pure $ Just (WidgetValue (SomeWidgetRef tc))

builtInInputWidget :: BuiltInFnWithDoc '[]
builtInInputWidget EmptyArgs = do
  iw <- input (Dimensions 60 10)
  pure $ Just (WidgetValue (SomeWidgetRef iw))

builtInSingleLineInputWidget :: BuiltInFnWithDoc '[]
builtInSingleLineInputWidget EmptyArgs = do
  iw <- input (Dimensions 60 1)
  pure $ Just (WidgetValue (SomeWidgetRef iw))

builtInTextLabelWidget :: BuiltInFnWithDoc '[ '("label", Text)]
builtInTextLabelWidget ((coerce -> label) :> EmptyArgs) = do
  tc <- textLabel (ScreenPos 0 0) (Dimensions 20 1) label
  pure $ Just (WidgetValue (SomeWidgetRef tc))

builtInTextRefLabelWidget :: BuiltInFnWithDoc '[ '("reflabel", MutableRef)]
builtInTextRefLabelWidget (((mref . coerce) -> label) :> EmptyArgs) = do
  tc <- textRefLabel (ScreenPos 0 0) (Dimensions 20 1) label
  pure $ Just (WidgetValue (SomeWidgetRef tc))

builtInSelectorWidget :: BuiltInFnWithDoc '[ '("label", Text), '("options", [(Value, Text)]), '("action", Maybe Callback)]
builtInSelectorWidget ((coerce -> (label :: Text)) :> (coerce -> options) :> (coerce -> cb) :>  EmptyArgs) = do
  tc <- selector label (ScreenPos 0 0) (Dimensions 20 1) options cb
  pure $ Just (WidgetValue (SomeWidgetRef tc))

builtInButtonWidget :: BuiltInFnWithDoc '[ '("label", Text), '("action", Maybe Callback)]
builtInButtonWidget ((coerce -> (label :: Text)) :>  (coerce -> (cb :: Maybe Callback)) :>  EmptyArgs) = do
  tc <- button (ScreenPos 0 0) (Dimensions (T.length label + 5) 3) label cb
  pure $ Just (WidgetValue (SomeWidgetRef tc))

builtInGetSelection :: BuiltInFnWithDoc '[ '("select", SomeWidgetRef) ]
builtInGetSelection ((coerce -> (SomeWidgetRef ref)) :>  EmptyArgs) =
  case cast ref of
    Just selectRef -> do
      getSelection selectRef  >>= \case
        Just x -> do
          pure $ Just x
        Nothing -> pure $ Just Void
    Nothing -> error "Selector widget is required"

builtInSetOptions :: BuiltInFnWithDoc '[ '("select", SomeWidgetRef), '("option", [(Value ,Text)]) ]
builtInSetOptions ((coerce -> (SomeWidgetRef ref)) :> (coerce -> (options :: [(Value, Text)])) :> EmptyArgs) = do
  case cast ref of
    Just selectRef -> setOptions selectRef options
    Nothing -> error "Selector widget is required"
  pure Nothing

builtInGetOptions :: BuiltInFnWithDoc '[ '("select", SomeWidgetRef) ]
builtInGetOptions ((coerce -> (SomeWidgetRef ref)) :> EmptyArgs) = do
  case cast ref of
    Just selectRef -> do
      options <- getOptions selectRef
      pure $ Just $ ArrayValue $ V.fromList ((ArrayValue . V.fromList . (\(a, b) -> [a, StringValue b])) <$> options)
    Nothing -> error "Selector widget is required"

builtInBorderBox :: BuiltInFnWithDoc '[ '("child", SomeWidgetRef) ]
builtInBorderBox ((coerce -> (c :: SomeWidgetRef)) :> EmptyArgs) = do
  bb <- borderBox (ScreenPos 0 0) (Dimensions 0 0) c
  pure $ Just (WidgetValue (SomeWidgetRef bb))

builtInAddWidget :: BuiltInFnWithDoc '[ '("widget", SomeWidgetRef), '("child", SomeWidgetRef)]
builtInAddWidget ((coerce -> (SomeWidgetRef parent)) :>  (coerce -> (SomeWidgetRef child)) :> EmptyArgs) = do
  withCapability (LayoutCap parent) $ do
    addWidget parent child
  pure Nothing

builtInAddWidgetAt :: BuiltInFnWithDoc '[ '("widget", SomeWidgetRef), '("stackorder", Int), '("child", SomeWidgetRef)]
builtInAddWidgetAt ((coerce -> (SomeWidgetRef parent)) :>  (coerce -> so) :> (coerce -> (SomeWidgetRef child)) :> EmptyArgs) = do
  withCapability (LayoutCap parent) $ do
    addWidget' parent so child
  pure Nothing

builtInDrawWidget :: BuiltInFnWithDoc '[ '("widget", SomeWidgetRef) ]
builtInDrawWidget ((coerce -> (SomeWidgetRef w)) :> EmptyArgs) = do
  withCapability (DrawableCap w) $ draw w
  pure Nothing

builtInSetWidgetSize :: BuiltInFnWithDoc '[ '("widget", SomeWidgetRef), '("size_x", Int), '("size_y", Int) ]
builtInSetWidgetSize ((coerce -> (SomeWidgetRef w)) :> (coerce -> sx) :> (coerce -> sy) :> EmptyArgs) = do
  withCapability (MoveableCap w) $ resize w (\d -> d { diW = sx, diH = sy })
  pure Nothing

builtInSetFocus :: BuiltInFnWithDoc '[ '("widget", SomeWidgetRef), '("bool", Bool) ]
builtInSetFocus ((coerce -> (SomeWidgetRef w)) :> (coerce -> b) :> EmptyArgs) = do
  withCapability (FocusableCap w) $ setFocus w b
  pure Nothing

builtInSetTextWidgetContent :: BuiltInFnWithDoc '[ '("widget", SomeWidgetRef), '("content", Text)]
builtInSetTextWidgetContent ((coerce -> (SomeWidgetRef w)) :> (coerce -> (content :: Text)) :> EmptyArgs) = do
  withCapability (ContainerCap w (Proxy @Text)) $ setContent w content
  pure Nothing

builtInHandleInput :: BuiltInFnWithDoc '[ '("widget", SomeWidgetRef), '("keyevent", [KeyEvent]) ]
builtInHandleInput ((coerce -> (SomeWidgetRef w)) :> (coerce -> (ke :: [KeyEvent])) :> EmptyArgs) = do
  withCapability (KeyInputCap w) $ UI.Widgets.Common.mapM_ (handleInput w) ke
  pure Nothing

toStringValFmt :: (Text, Int,  [Int]) -> Value -> Text
toStringValFmt (s, _, p) v@(NumberValue (NumberInt _)) = amountFormat s p $ toStringVal v
toStringValFmt (s, f, p) (NumberValue (NumberFractional x)) = amountFormat s p $ T.pack $ printf ("%0." Prelude.++ show f Prelude.++ "f") x
toStringValFmt _ v = toStringVal v

builtinEncodeBytes :: BuiltInFnWithDoc '[ '("bytes", BS.ByteString)]
builtinEncodeBytes ((coerce -> bs) :> EmptyArgs) =
  pure $ Just $ StringValue $ encodeHex bs

builtinDecodeBytes :: BuiltInFnWithDoc '[ '("string", Text)]
builtinDecodeBytes ((coerce -> ebs) :> EmptyArgs) =
  case decodeHex ebs of
    Just bs -> pure $ Just $ BytesValue bs
    Nothing -> error "Input cannot be decoded as bytes"

printValLn :: BuiltInFnWithDoc '[ '("value", Variadic)]
printValLn ((coerce -> (Variadic vals)) :> EmptyArgs) = do
  outH <- isOutputHandle <$> getInterpretM
  tstrFn <- isDefaultPrintParams <$> getInterpretM >>= \case
    Just p  -> pure $ toStringValFmt p
    Nothing -> pure toStringVal
  liftIO $ do
    UI.Widgets.Common.mapM_ (T.hPutStr outH) (tstrFn <$> vals)
    T.hPutStrLn outH ""
    S.hFlush outH
  pure Nothing

printVal :: BuiltInFnWithDoc '[ '("value", Variadic)]
printVal ((coerce -> (Variadic vals)) :> EmptyArgs) = do
  outH <- isOutputHandle <$> getInterpretM
  tstrFn <- isDefaultPrintParams <$> getInterpretM >>= \case
    Just p  -> pure $ toStringValFmt p
    Nothing -> pure toStringVal
  liftIO $ do
    UI.Widgets.Common.mapM_ (T.hPutStr outH) (tstrFn <$> vals)
    S.hFlush outH
  pure Nothing

numberFromString :: BuiltInFnWithDoc '[ '("string", Text)]
numberFromString ((coerce -> (T.unpack -> str)) :> EmptyArgs) = case readMaybe @IntType str  of
  Just i -> pure $ Just $ NumberValue $ NumberInt i
  Nothing  -> case readMaybe @FloatType str of
    Just i -> pure $ Just $ NumberValue $ NumberFractional i
    Nothing -> pure $ throwErr $ CustomRTE "String cannot be converted to a number"

multiplication :: BuiltInFn
multiplication (NumberValue v1: NumberValue v2 : []) = pure $ Just $ NumberValue $ numberBinaryFn (*) v1 v2
multiplication a = throwBadArgs a "number"

addition :: BuiltInFn
addition (NumberValue v1: NumberValue v2 : []) = pure $ Just $ NumberValue $ numberBinaryFn (+) v1 v2
addition (ArrayValue i1 : ArrayValue i2 : []) = pure $ Just $ ArrayValue $ i1 V.++ i2
addition a = throwBadArgs a "number/list"

substraction :: BuiltInFn
substraction (NumberValue v1: NumberValue v2 : []) = pure $ Just $ NumberValue $ numberBinaryFn (-) v1 v2
substraction a = throwBadArgs a "number"

division :: BuiltInFn
division (NumberValue _: NumberValue (NumberInt 0) : []) = throwErr $ CustomRTE "Divison by zero!"
division (NumberValue _: NumberValue (NumberFractional 0.0) : []) = throwErr $ CustomRTE "Divison by zero!"
division (NumberValue v1: NumberValue v2 : []) = pure $ Just $ NumberValue $ numberBinaryFractionalFn (/) v1 v2
division a = throwBadArgs a "number"

comparison :: (Value -> Value -> Bool) -> BuiltInFn
comparison fn (v1: v2 : []) = pure $ Just $ BoolValue (fn v1 v2)
comparison _ a              = throwBadArgs a "values"

boolean :: (Bool -> Bool -> Bool) -> BuiltInFn
boolean fn (BoolValue v1 : BoolValue v2 : []) = pure $ Just $ BoolValue (fn v1 v2)
boolean _ a              = throwBadArgs a "bools"

not' :: BuiltInFnWithDoc '[ '("bool", Bool)]
not' ((coerce -> v1) :> _) = pure $ Just $ BoolValue (not v1)

contains :: BuiltInFnWithDoc '[ '("list", TextOrList), '("item", Value)]
contains ((coerce -> v1) :> (coerce -> v2) :> EmptyArgs) = case v1 of
  TCText t -> case v2 of
    StringValue v -> pure $ Just $ BoolValue $ T.isInfixOf v t
    v             -> throwBadArgs [v] "string"
  TCList lst -> pure $ Just $ BoolValue $ V.foldl' fn False lst
    where
      fn :: Bool -> Value -> Bool
      fn True _  = True
      fn False v = v2 == v

haskey :: BuiltInFnWithDoc '[ '("dictionary",  M.Map Text Value), '("key", Text)]
haskey ((coerce -> (map' :: M.Map Text Value)) :> (coerce -> key) :> _) = pure $ Just $ BoolValue $ M.member key map'

getkey :: BuiltInFnWithDoc '[ '("dictionary",  M.Map Text Value), '("key", Text)]
getkey ((coerce -> (map' :: M.Map Text Value)) :> (coerce -> key) :> _) = case M.lookup key map' of
  Just v ->  pure $ Just v
  Nothing -> pure $ Just $ ErrorValue $ "Key '" <> key <> "' not found in dictionary"

addkey :: BuiltInFnWithDoc '[ '("dictionary",  M.Map Text Value), '("key", Text), '("value", Value)]
addkey ((coerce -> (map' :: M.Map Text Value)) :> (coerce -> key) :> (coerce -> val) :> EmptyArgs) = pure $ Just $ ObjectValue $ M.insert key val map'

builtInRepeat :: BuiltInFnWithDoc ['("count", Int), '("source", Value)]
builtInRepeat ((coerce -> c) :> (coerce -> vl) :>  EmptyArgs) = pure $ Just $ ArrayValue $ V.fromList $ Prelude.take c $ repeat vl

builtInTake :: BuiltInFnWithDoc ['("count", Int), '("source", TextOrList)]
builtInTake ((coerce -> c) :> (coerce -> vl) :>  EmptyArgs) = case vl of
  TCText t -> pure $ Just $ StringValue $ T.take c t
  TCList l -> pure $ Just $ ArrayValue (V.take c l)

builtInDrop :: BuiltInFnWithDoc ['("count", Int), '("source", TextOrList)]
builtInDrop ((coerce -> c) :> (coerce -> vl) :> EmptyArgs) = case vl of
  TCText t -> pure $ Just $ StringValue $ T.drop c t
  TCList l -> pure $ Just $ ArrayValue (V.drop c l)

builtInArrayInsertLeft :: BuiltInFnWithDoc ['("item", Value), '("initial_list", Vector Value)]
builtInArrayInsertLeft ((coerce -> c) :> (coerce -> v1) :> _) = pure $ Just $ ArrayValue (V.cons c v1)

builtInArrayInsertRight :: BuiltInFnWithDoc ['("initial_list", Vector Value), '("item", Value)]
builtInArrayInsertRight ((coerce -> v1) :> (coerce -> c) :> _) = pure $ Just $ ArrayValue (V.snoc v1 c)

builtInHead :: BuiltInFnWithDoc '[ '("source_list", Vector Value)]
builtInHead ((coerce -> v1) :> _) = case V.uncons v1 of
  Just (x, _) -> pure $ Just x
  Nothing     -> throwErr $ CustomRTE "Empty list found for 'head' call"

builtInTry :: BuiltInFnWithDoc '[ '("evaluation", EitherError Value), '("alternate", Value)]
builtInTry ((coerce -> evaluation) :>  (coerce -> alternate) :> _) = case evaluation of
  EitherError (Left _)  -> pure $ Just alternate
  EitherError (Right v) -> pure $ Just v

builtInTimestamp :: BuiltInFnWithDoc '[]
builtInTimestamp _ = do
  st <- liftIO getSystemTimestamp
  pure $ Just $ NumberValue $ NumberInt st

serializeJSON :: Value -> InterpretM BS.ByteString
serializeJSON v =
  (BSL.toStrict . A.encode) <$> toAesonVal v

builtInJSONSerialize :: BuiltInFnWithDoc '[ '("value", Value)]
builtInJSONSerialize ((coerce -> (v :: Value)) :> _) =
  (Just . BytesValue ) <$> serializeJSON v

builtInInspect :: BuiltInFnWithDoc '[ '("value", Value)]
builtInInspect ((coerce -> (v :: Value)) :> _) = do
  vText <- decodeUtf8 <$> serializeJSON v
  interpreterOutput vText
  interpreterOutputFlush
  pure Nothing

builtInJSONParse :: BuiltInFnWithDoc '[ '("value", Value)]
builtInJSONParse v  = let
  bytes = case v of
    ((coerce -> (StringValue b)) :> _) -> encodeUtf8 b
    ((coerce -> (BytesValue b)) :> _) -> b
    ((coerce -> (a :: Value)) :> _) -> throwErr $ BadArguments ("String/Bytes", T.pack $ show a)
  in case A.eitherDecodeStrict bytes of
    Right val -> pure $ Just $ fromAesonVal val
    Left err -> throwErr $ CustomRTE ("JSON decoding failed with error:" <> (T.pack err))

builtInError :: BuiltInFnWithDoc '[ '("message", Text)]
builtInError ((coerce -> v) :> EmptyArgs) =
  pure $ Just $ ErrorValue v

builtInIsError :: BuiltInFnWithDoc '[ '("value", Value)]
builtInIsError ((coerce -> v) :> _) = case v of
  ErrorValue _ -> pure $ Just $ BoolValue True
  _ -> pure $ Just $ BoolValue False

builtInDebug :: BuiltInFnWithDoc '[]
builtInDebug _ = do
  modifyInterpretM (\is -> case isRunMode is of
    DebugMode debugEnv -> is { isRunMode = DebugMode (debugEnv { deStepMode = SingleStep }) }
    _ -> is
    )
  pure Nothing

fromAesonVal :: A.Value -> Value
fromAesonVal (A.String s) = StringValue s
fromAesonVal (A.Number s) = NumberValue $ if S.isInteger s then NumberInt (round s) else NumberFractional (realToFrac s)
fromAesonVal (A.Bool b) = BoolValue b
fromAesonVal (A.Array b) = ArrayValue (fromAesonVal <$> b)
fromAesonVal (A.Object b) = ObjectValue (M.fromList $ (\(a, b') -> (A.toText a, fromAesonVal b')) <$> (A.toList b))
fromAesonVal A.Null = Void

toAesonVal :: Value -> InterpretM A.Value
toAesonVal Void = pure A.Null
toAesonVal (StringValue s) = pure $ A.String s
toAesonVal (NumberValue (NumberInt n)) = pure $ A.Number $ fromIntegral n
toAesonVal (NumberValue (NumberFractional n)) = pure $ A.Number $ realToFrac n
toAesonVal (BoolValue b) = pure $ A.Bool b
toAesonVal (ArrayValue b) = do
  vs <- V.mapM (\x -> toAesonVal x) b
  pure $ A.Array vs
toAesonVal (ObjectValue b) = do
  vs <- Prelude.mapM (\(k, x) -> do v <- toAesonVal x; pure (A.fromText k, v)) $ M.toList b
  pure $ A.Object $ A.fromList vs
toAesonVal _ = throwErr UnserializeableValue

waitMillisec :: BuiltInFnWithDoc '[ '("timeinseconds", Number)]
waitMillisec ((coerce -> number) :> _) = (liftIO $ waitMillisec' number) >> pure Nothing

waitForKey :: BuiltInFnWithDoc '[]
waitForKey _ = do
  inputHandle <- isInputHandle <$> getInterpretM
  c <- liftIO $ readKey_ inputHandle
  pure $ Just $ ArrayValue $ V.fromList (EventValue <$> strToKeyEvent c)

builtinInputLine :: BuiltInFnWithDoc '[ '("prompt", Text)]
builtinInputLine ((coerce -> prompt) :> _) = do
  interpreterOutput prompt
  interpreterOutputFlush
  (Just . StringValue) <$> readInterpreterInputLine

builtinImport :: BuiltInFnWithDoc '[ '("filepath", FilePath)]
builtinImport ((coerce -> filepath) :> _) =
  Just <$> importModule filepath

builtinExec :: BuiltInFnWithDoc '[ '("filepath", FilePath), '("args", [String])]
builtinExec ((coerce -> filepath) :> (coerce -> (args :: [String])) :> _) = do
  liftIO $ callProcess filepath args
  pure Nothing

builtinCreateDirectory :: BuiltInFnWithDoc '[ '("filepath", FilePath), '("createParents", Bool)]
builtinCreateDirectory ((coerce -> filePath) :> (coerce -> (createParents :: Bool)) :> _) = do
  liftIO $ createDirectoryIfMissing createParents filePath
  pure Nothing

valueSize :: BuiltInFnWithDoc '[ '("list_or_map", Value)]
valueSize ((coerce -> v1) :> _) = case v1 of
  ArrayValue v  -> pure $ Just $ NumberValue $ NumberInt $ fromIntegral $ V.length v
  ObjectValue m -> pure $ Just $ NumberValue $ NumberInt $ fromIntegral $ M.size m
  StringValue t -> pure $ Just $ NumberValue $ NumberInt $ fromIntegral $ T.length t
  BytesValue t -> pure $ Just $ NumberValue $ NumberInt $ fromIntegral $ BS.length t
  v             -> throwErr (UnexpectedType ("Array/Object/Bytes/String", v))

builtinConsoleLog :: BuiltInFnWithDoc '[ '("msg", Text)]
builtinConsoleLog ((coerce -> msg) :> _) = do
  consoleLog msg
  pure Nothing

consoleLog :: Text -> InterpretM ()
consoleLog msg = do
  isLogChannel <$> getInterpretM >>= \case
    Just chan ->  liftIO $ atomically $ writeTChan chan msg
    Nothing -> pass

importModule :: FilePath -> InterpretM Value
importModule filePath = do
  fullPath <- isCurrentModulePath <$> getInterpretM >>= \case
    Just p -> liftIO $ canonicalizePath $ p </> filePath
    Nothing -> error "Import path not available"
  content <- do
    liftIO $ T.readFile fullPath
  program <- liftIO $ compile @Program content
  pushModuleScope mempty
  modifyInterpretM (\is -> is { isCurrentModulePath = Just $ takeDirectory fullPath })
  interpretPassOne program
  interpretPassTwo program
  moduleScope <- popModuleScope
  scopeTVar <- liftIO $ newTVarIO moduleScope
  pure $ ModuleValue filePath (ScopeRef scopeTVar) Nothing