--  --                                                          ; {{{1
--
--  File        : Koneko/JSON.hs
--  Maintainer  : Felix C. Stegerman <flx@obfusk.net>
--  Date        : 2020-11-12
--
--  Copyright   : Copyright (C) 2020  Felix C. Stegerman
--  Version     : v0.0.1
--  License     : GPLv3+
--
--  --                                                          ; }}}1

{-# LANGUAGE OverloadedStrings #-}

module Koneko.JSON (initCtx) where

import Control.Exception (throwIO)
import Data.Foldable (traverse_)

import Koneko.Data

initCtx :: Context -> IO ()
initCtx :: Context -> IO ()
initCtx Context
ctxMain = do
  Context
ctx <- Identifier -> Context -> IO Context
forkContext Identifier
"json" Context
ctxMain
  (Builtin -> IO ()) -> [Builtin] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Context -> Builtin -> IO ()
defPrim Context
ctx) [Builtin
jsonTo, Builtin
jsonFrom]

jsonTo, jsonFrom :: Builtin
jsonTo :: Builtin
jsonTo = Identifier -> Evaluator -> Builtin
mkBltn Identifier
"->" (Evaluator -> Builtin) -> Evaluator -> Builtin
forall a b. (a -> b) -> a -> b
$ \Context
_ Stack
s -> do
  (Identifier
x, Stack
s') <- Stack -> IO (Identifier, Stack)
forall a. FromVal a => Stack -> IO (a, Stack)
pop' Stack
s; (KException -> IO Stack)
-> (KValue -> IO Stack) -> Either KException KValue -> IO Stack
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either KException -> IO Stack
forall e a. Exception e => e -> IO a
throwIO (Stack -> KValue -> IO Stack
forall a. ToVal a => Stack -> a -> IO Stack
rpush1 Stack
s') (Either KException KValue -> IO Stack)
-> Either KException KValue -> IO Stack
forall a b. (a -> b) -> a -> b
$ Identifier -> Either KException KValue
fromJSON Identifier
x
jsonFrom :: Builtin
jsonFrom = Identifier -> Evaluator -> Builtin
mkBltn Identifier
"<-" (Evaluator -> Builtin) -> Evaluator -> Builtin
forall a b. (a -> b) -> a -> b
$ \Context
_ Stack
s -> do
  (KValue
x, Stack
s') <- Stack -> IO (KValue, Stack)
forall a. FromVal a => Stack -> IO (a, Stack)
pop' Stack
s; (KException -> IO Stack)
-> (Identifier -> IO Stack)
-> Either KException Identifier
-> IO Stack
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either KException -> IO Stack
forall e a. Exception e => e -> IO a
throwIO (Stack -> Identifier -> IO Stack
forall a. ToVal a => Stack -> a -> IO Stack
rpush1 Stack
s') (Either KException Identifier -> IO Stack)
-> Either KException Identifier -> IO Stack
forall a b. (a -> b) -> a -> b
$ KValue -> Either KException Identifier
toJSON KValue
x

-- vim: set tw=70 sw=2 sts=2 et fdm=marker :