Misc.hs

module Interpreter.Lib.Misc where

import Control.Monad.IO.Class
import Control.Monad.State.Strict as SM
import Text.Read (readMaybe)
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 qualified Data.Scientific as S
import Data.Text as T
import Data.Text.Encoding
import Data.Text.IO as T
import Data.Time.Clock.System
import Data.Vector as V
import qualified System.IO as S
import qualified System.IO as SIO
import Text.Hex (encodeHex)

import Interpreter.Common
import UI.Widgets.Common
import Common

printValLn :: BuiltInFnWithDoc '[ '("value", Variadic)]
printValLn ((coerce -> (Variadic vals)) :> EmptyArgs) = do
  liftIO $ do
    UI.Widgets.Common.mapM_ T.putStr (toStringVal <$> vals)
    T.putStrLn ""
    S.hFlush S.stdout
  pure Nothing

printVal :: BuiltInFnWithDoc '[ '("value", Variadic)]
printVal ((coerce -> (Variadic vals)) :> EmptyArgs) = do
  liftIO $ do
    UI.Widgets.Common.mapM_ T.putStr (toStringVal <$> vals)
    S.hFlush S.stdout
  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'

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)

builtInWriteFile :: BuiltInFnWithDoc '[ '("filename", FilePath), '("data", BytesOrText)]
builtInWriteFile ((coerce -> filepath) :> (coerce -> bot) :> EmptyArgs) = liftIO $ case bot of
  BTBytes bin -> do
      BS.writeFile filepath bin
      pure Nothing
  BTText dat -> do
      T.writeFile filepath dat
      pure Nothing

builtInReadFile :: BuiltInFnWithDoc '[ '("filename", FilePath)]
builtInReadFile ((coerce -> filepath) :> _) = liftIO $ do
  c <- BS.readFile filepath
  pure $ Just $ BytesValue c

builtInReadTextFile :: BuiltInFnWithDoc '[ '("filename", FilePath)]
builtInReadTextFile ((coerce -> filepath) :> _) = do
  c <- liftIO $ T.readFile filepath
  pure $ Just $ StringValue 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 $ truncateSystemTimeLeapSecond <$> getSystemTime
  pure $ Just $ NumberValue $ NumberInt $ ((fromIntegral $ systemSeconds st) * 1e9) + (fromIntegral $ systemNanoseconds 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))

builtInDebug :: BuiltInFnWithDoc '[]
builtInDebug _ = do
  SM.modify (\is -> case isRunMode is of
    NormalMode (Just 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 <$> get
  c <- liftIO $ SIO.hGetChar inputHandle
  pure $ Just $ StringValue $ T.singleton c

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

toStringVal :: Value -> Text
toStringVal = \case
  StringValue t                    -> t
  NumberValue (NumberInt i)        -> pack $ show i
  NumberValue (NumberFractional i) -> pack $ show i
  BoolValue True                   -> "true"
  BoolValue False                  -> "false"
  BytesValue b                     -> "0x" <> encodeHex b
  ArrayValue _                     -> "[array]"
  ObjectValue _                    -> "[object]"
  ProcedureValue _                 -> "(procedure)"
  ThreadRef _                      -> "(thread_ref)"
  Channel _                        -> "(concurrency_channel)"
  Ref _                            -> "(mutable_ref)"
  UnnamedFnValue _                 -> "(unnamed_function)"
  Void                             -> "(void)"
  BuiltIn _                        -> "(builtin)"
  s@(ErrorValue _)                 -> pack $ show s
  SDLValue s                       -> pack $ show s

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
  v             -> throwErr (UnexpectedType ("Array or Object", v))