{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-|
Module      : Recalc.Univer
Description : Type class and generic language server implementation (backend for a Univer frontend).

This module defines the interface "UniverRecalc" for which 'univerMain' is defined:

@
univerMain @Term (env0 :: EnvOf Term) :: IO ()
@

which will run a spreadsheet language server serving a Univer frontend.
-}
module Recalc.Univer
  ( Annotation (..)
  , FunctionDescription (..)
  , FunctionParameter (..)
  , FunctionType (..)
  , UniverRecalc (..)
  , univerMain
  ) where

import Control.Monad.Reader (MonadIO (liftIO), runReaderT)
import Control.Monad.State (gets, modify, state)
import Data.Bifunctor (bimap, second)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Monoid (Endo (Endo, appEndo))
import Data.Text (Text)
import Data.Text qualified as Text
import Network.URI (URI)
import Prettyprinter (Pretty, defaultLayoutOptions, layoutPretty, pretty)
import Prettyprinter.Render.Text (renderStrict)
import Text.Megaparsec (errorBundlePretty)

import Recalc.Engine
import Recalc.Server
import Recalc.Univer.Internal
import Recalc.Univer.Protocol

class (Recalc t, Pretty t, Show (ErrorOf t)) => UniverRecalc t where
  errorAnnotation :: ErrorOf t -> Annotation

  define
    :: Text
    -> Map
        CellAddr
        (Maybe ((String, CellType), Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
    -> [(Text, CellRange)]
    -> CellRange
    -> EnvOf t
    -> Either (ErrorOf t) (EnvOf t)
  define Text
_ Map
  CellAddr
  (Maybe
     ((String, CellType),
      Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
_ [(Text, CellRange)]
_ CellRange
_ = EnvOf t -> Either (ErrorOf t) (EnvOf t)
forall a b. b -> Either a b
Right

type SheetsApi = ToApi SpreadsheetProtocol

univerMain :: forall t. UniverRecalc t => EnvOf t -> IO ()
univerMain :: forall t. UniverRecalc t => EnvOf t -> IO ()
univerMain EnvOf t
env = forall {k} (api :: k) engine.
HasHandler api =>
engine -> (State engine -> HandlerT api IO) -> IO ()
forall api engine.
HasHandler api =>
engine -> (State engine -> HandlerT api IO) -> IO ()
runHandler @SheetsApi (EnvOf t
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall env err f t e v. env -> EngineState env err f t e v
newEngineState EnvOf t
env) ((State
    (EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
  -> HandlerT SheetsApi IO)
 -> IO ())
-> (State
      (EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
    -> HandlerT SheetsApi IO)
-> IO ()
forall a b. (a -> b) -> a -> b
$ \State
  (EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
st ->
  forall api (m :: * -> *) (n :: * -> *).
HasHandler api =>
(forall x. m x -> n x) -> HandlerT api m -> HandlerT api n
forall {k} (api :: k) (m :: * -> *) (n :: * -> *).
HasHandler api =>
(forall x. m x -> n x) -> HandlerT api m -> HandlerT api n
hoist @SheetsApi (ReaderT
  (State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
  IO
  x
-> State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> IO x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` State
  (EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
st) (SpreadsheetProtocol
  (AsServerT
     (Handler
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))))
-> GToSum
     (Rep
        (SpreadsheetProtocol
           (AsServerT
              (Handler
                 (EngineState
                    (EnvOf t)
                    (ErrorOf t)
                    t
                    (TypeOf t)
                    (ElaborationOf t)
                    (ValueOf t))))))
forall {k} (m :: k) (api' :: k -> *).
(GenericMode m, Generic (api' m), GSum (Rep (api' m))) =>
api' m -> GToSum (Rep (api' m))
namedHandlers SpreadsheetProtocol
  (AsServerT
     (Handler
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))))
server)
 where
  -- ignore request id
  params :: (a, b) -> b
params = (a, b) -> b
forall a b. (a, b) -> b
snd

  server :: SpreadsheetProtocol (AsServerT (Handler (EngineStateOf t)))
  server :: SpreadsheetProtocol
  (AsServerT
     (Handler
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))))
server =
    SpreadsheetProtocol
      { rpcOpen :: AsServerT
  (Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
:- JsonRpc "open" OpenParams ()
rpcOpen = OpenParams
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t. OpenParams -> Handler (EngineStateOf t) ()
Recalc.Univer.rpcOpen (OpenParams
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> ((Maybe Id, OpenParams) -> OpenParams)
-> (Maybe Id, OpenParams)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Id, OpenParams) -> OpenParams
forall a b. (a, b) -> b
params
      , rpcSave :: AsServerT
  (Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
:- JsonRpc "save" SaveParams ()
rpcSave = SaveParams
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t.
(Recalc t, Show (ErrorOf t)) =>
SaveParams -> Handler (EngineStateOf t) ()
Recalc.Univer.rpcSave (SaveParams
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> ((Maybe Id, SaveParams) -> SaveParams)
-> (Maybe Id, SaveParams)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Id, SaveParams) -> SaveParams
forall a b. (a, b) -> b
params
      , rpcClose :: AsServerT
  (Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
:- JsonRpc "close" CloseParams ()
rpcClose = CloseParams
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t. CloseParams -> Handler (EngineStateOf t) ()
Recalc.Univer.rpcClose (CloseParams
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> ((Maybe Id, CloseParams) -> CloseParams)
-> (Maybe Id, CloseParams)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Id, CloseParams) -> CloseParams
forall a b. (a, b) -> b
params
      , rpcSetRangeValues :: AsServerT
  (Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
:- JsonRpc "setRangeValues" SetRangeValuesParams Cells
rpcSetRangeValues = SetRangeValuesParams
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     Cells
forall t.
UniverRecalc t =>
SetRangeValuesParams -> Handler (EngineStateOf t) Cells
Recalc.Univer.rpcSetRangeValues (SetRangeValuesParams
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      Cells)
-> ((Maybe Id, SetRangeValuesParams) -> SetRangeValuesParams)
-> (Maybe Id, SetRangeValuesParams)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     Cells
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Id, SetRangeValuesParams) -> SetRangeValuesParams
forall a b. (a, b) -> b
params
      , rpcInsertSheet :: AsServerT
  (Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
:- JsonRpc "insertSheet" InsertSheetParams ()
rpcInsertSheet = InsertSheetParams
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t. InsertSheetParams -> Handler (EngineStateOf t) ()
Recalc.Univer.rpcInsertSheet (InsertSheetParams
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> ((Maybe Id, InsertSheetParams) -> InsertSheetParams)
-> (Maybe Id, InsertSheetParams)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Id, InsertSheetParams) -> InsertSheetParams
forall a b. (a, b) -> b
params
      , rpcRemoveSheet :: AsServerT
  (Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
:- JsonRpc "removeSheet" RemoveSheetParams ()
rpcRemoveSheet = RemoveSheetParams
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t. RemoveSheetParams -> Handler (EngineStateOf t) ()
Recalc.Univer.rpcRemoveSheet (RemoveSheetParams
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> ((Maybe Id, RemoveSheetParams) -> RemoveSheetParams)
-> (Maybe Id, RemoveSheetParams)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Id, RemoveSheetParams) -> RemoveSheetParams
forall a b. (a, b) -> b
params
      , rpcSetWorksheetOrder :: AsServerT
  (Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
:- JsonRpc "setWorksheetOrder" SetWorksheetOrderParams ()
rpcSetWorksheetOrder = SetWorksheetOrderParams
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t. SetWorksheetOrderParams -> Handler (EngineStateOf t) ()
Recalc.Univer.rpcSetWorksheetOrder (SetWorksheetOrderParams
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> ((Maybe Id, SetWorksheetOrderParams) -> SetWorksheetOrderParams)
-> (Maybe Id, SetWorksheetOrderParams)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Id, SetWorksheetOrderParams) -> SetWorksheetOrderParams
forall a b. (a, b) -> b
params
      , rpcSetWorksheetName :: AsServerT
  (Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
:- JsonRpc "setWorksheetName" SetWorksheetNameParams ()
rpcSetWorksheetName = SetWorksheetNameParams
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t.
UniverRecalc t =>
SetWorksheetNameParams -> Handler (EngineStateOf t) ()
Recalc.Univer.rpcSetWorksheetName (SetWorksheetNameParams
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> ((Maybe Id, SetWorksheetNameParams) -> SetWorksheetNameParams)
-> (Maybe Id, SetWorksheetNameParams)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Id, SetWorksheetNameParams) -> SetWorksheetNameParams
forall a b. (a, b) -> b
params
      , rpcDefineFunction :: AsServerT
  (Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
:- JsonRpc
     "defineFunction"
     DefineFunctionParams
     (Either Text [FunctionDescription])
rpcDefineFunction = DefineFunctionParams
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     (Either Text [FunctionDescription])
forall t.
UniverRecalc t =>
DefineFunctionParams
-> Handler (EngineStateOf t) (Either Text [FunctionDescription])
Recalc.Univer.rpcDefineFunction (DefineFunctionParams
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      (Either Text [FunctionDescription]))
-> ((Maybe Id, DefineFunctionParams) -> DefineFunctionParams)
-> (Maybe Id, DefineFunctionParams)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     (Either Text [FunctionDescription])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Id, DefineFunctionParams) -> DefineFunctionParams
forall a b. (a, b) -> b
params
      }

modifyDocs
  :: (DocumentStoreOf t -> DocumentStoreOf t) -> Handler (EngineStateOf t) ()
modifyDocs :: forall t.
(DocumentStoreOf t -> DocumentStoreOf t)
-> Handler (EngineStateOf t) ()
modifyDocs = State
  (EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
  ()
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall engine a. State engine a -> Handler engine a
liftEngine (State
   (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
   ()
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> ((Map
       URI
       (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     -> Map
          URI
          (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
    -> State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
         ())
-> (Map
      URI
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
    -> Map
         URI
         (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((EngineState
    (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
  -> EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> State
      (EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
      ())
-> ((Map
       URI
       (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     -> Map
          URI
          (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
    -> EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
    -> EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> (Map
      URI
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
    -> Map
         URI
         (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   URI
   (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> Map
      URI
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall err f t e v env.
(DocumentStore err f t e v -> DocumentStore err f t e v)
-> EngineState env err f t e v -> EngineState env err f t e v
mapDocs

modifyDocument
  :: URI
  -> ([Text] -> [Text])
  -> (Map Text (SheetOf t) -> Map Text (SheetOf t))
  -> Handler (EngineStateOf t) ()
modifyDocument :: forall t.
URI
-> ([Text] -> [Text])
-> (Map Text (SheetOf t) -> Map Text (SheetOf t))
-> Handler (EngineStateOf t) ()
modifyDocument URI
uri [Text] -> [Text]
f Map Text (SheetOf t) -> Map Text (SheetOf t)
g =
  (DocumentStoreOf t -> DocumentStoreOf t)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t.
(DocumentStoreOf t -> DocumentStoreOf t)
-> Handler (EngineStateOf t) ()
modifyDocs
    ((DocumentStoreOf t -> DocumentStoreOf t)
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> (DocumentStoreOf t -> DocumentStoreOf t)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall a b. (a -> b) -> a -> b
$ (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> Maybe
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> URI -> DocumentStoreOf t -> DocumentStoreOf t
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update
      (\(Document [Text]
sheetOrder Map Text (SheetOf t)
sheets) -> Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Maybe
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall a. a -> Maybe a
Just (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> Maybe
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Maybe
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall a b. (a -> b) -> a -> b
$ [Text]
-> Map Text (SheetOf t)
-> Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall err f t e v.
[Text] -> Map Text (Sheet err f t e v) -> Document err f t e v
Document ([Text] -> [Text]
f [Text]
sheetOrder) (Map Text (SheetOf t) -> Map Text (SheetOf t)
g Map Text (SheetOf t)
sheets))
      URI
uri

{- JSON-RPC Handlers -}

rpcOpen :: OpenParams -> Handler (EngineStateOf t) ()
rpcOpen :: forall t. OpenParams -> Handler (EngineStateOf t) ()
rpcOpen OpenParams{open'uri :: OpenParams -> URI
open'uri = URI
uri, open'sheetOrder :: OpenParams -> [Text]
open'sheetOrder = [Text]
sheetOrder} = do
  -- insert the document at uri & initialise each sheet
  let
    insertDocAndSheets :: Map
  URI
  (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
insertDocAndSheets =
      URI
-> Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert URI
uri (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> Map
      URI
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> Map
      URI
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> (Map
      Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
    -> Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text]
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall err f t e v.
[Text] -> Map Text (Sheet err f t e v) -> Document err f t e v
Document [Text]
sheetOrder
        (Map
   Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> Map
      URI
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> Map
      URI
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall a b. (a -> b) -> a -> b
$ Endo
  (Map
     Text
     (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall a. Endo a -> a -> a
appEndo ((Text
 -> Endo
      (Map
         Text
         (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))))
-> [Text]
-> Endo
     (Map
        Text
        (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Map
   Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> Map
      Text
      (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> Endo
     (Map
        Text
        (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
forall a. (a -> a) -> Endo a
Endo ((Map
    Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
  -> Map
       Text
       (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
 -> Endo
      (Map
         Text
         (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))))
-> (Text
    -> Map
         Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
    -> Map
         Text
         (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> Text
-> Endo
     (Map
        Text
        (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
-> Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall k a. Ord k => k -> a -> Map k a -> Map k a
`Map.insert` Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall a. Monoid a => a
mempty)) [Text]
sheetOrder) Map
  Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall a. Monoid a => a
mempty
  (Map
   URI
   (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> Map
      URI
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> Handler (EngineStateOf t) ()
forall t.
(DocumentStoreOf t -> DocumentStoreOf t)
-> Handler (EngineStateOf t) ()
modifyDocs Map
  URI
  (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
insertDocAndSheets

rpcSave :: (Recalc t, Show (ErrorOf t)) => SaveParams -> Handler (EngineStateOf t) ()
rpcSave :: forall t.
(Recalc t, Show (ErrorOf t)) =>
SaveParams -> Handler (EngineStateOf t) ()
rpcSave SaveParams
_ = ReaderT
  (State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
  IO
  ()
forall engine. Show engine => Handler engine ()
dumpEngineState ReaderT
  (State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
  IO
  ()
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall a b.
ReaderT
  (State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
  IO
  a
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     b
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall a.
String
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"'save' not implemented"

rpcClose :: CloseParams -> Handler (EngineStateOf t) ()
rpcClose :: forall t. CloseParams -> Handler (EngineStateOf t) ()
rpcClose CloseParams
_ = String
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall a.
String
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"'close' not implemented"

rpcSetRangeValues
  :: UniverRecalc t
  => SetRangeValuesParams
  -> Handler (EngineStateOf t) Cells
rpcSetRangeValues :: forall t.
UniverRecalc t =>
SetRangeValuesParams -> Handler (EngineStateOf t) Cells
rpcSetRangeValues SetRangeValuesParams{setRangeValues'cells :: SetRangeValuesParams -> Cells
setRangeValues'cells = Cells Map CellAddr CellData
rcMap, Text
URI
setRangeValues'uri :: URI
setRangeValues'sheetName :: Text
setRangeValues'sheetName :: SetRangeValuesParams -> Text
setRangeValues'uri :: SetRangeValuesParams -> URI
..} = do
  ReaderT
  (State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
  IO
  ()
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall engine.
ReaderT (State engine) IO () -> ReaderT (State engine) IO ()
scheduleJob (ReaderT
   (State
      (EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
   IO
   ()
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall a b. (a -> b) -> a -> b
$ do
    let
      sheetId :: (URI, Text)
sheetId = (URI
setRangeValues'uri, Text
setRangeValues'sheetName)

      inputs :: [(CellRef, (Maybe (String, CellType), Meta))]
      inputs :: [(CellRef, (Maybe (String, CellType), Meta))]
inputs = ((CellAddr, CellData)
 -> (CellRef, (Maybe (String, CellType), Meta)))
-> [(CellAddr, CellData)]
-> [(CellRef, (Maybe (String, CellType), Meta))]
forall a b. (a -> b) -> [a] -> [b]
map ((CellAddr -> CellRef)
-> (CellData -> (Maybe (String, CellType), Meta))
-> (CellAddr, CellData)
-> (CellRef, (Maybe (String, CellType), Meta))
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((URI, Text)
sheetId,) CellData -> (Maybe (String, CellType), Meta)
unpackCellData) (Map CellAddr CellData -> [(CellAddr, CellData)]
forall k a. Map k a -> [(k, a)]
Map.toList Map CellAddr CellData
rcMap)

    State
  (EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
  (Either
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either
        [(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
        [(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
forall engine a. State engine a -> Handler engine a
liftEngine ((EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> (Either
       [(CellRef,
         Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
       [(CellRef,
         Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
     EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either
        [(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
        [(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
forall a.
(EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> (a,
     EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> StateT
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     Identity
     a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ([(CellRef, (Maybe (String, CellType), Meta))]
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall f.
(Recalc f, Show (ErrorOf f)) =>
[(CellRef, (Maybe (String, CellType), Meta))]
-> EngineStateOf f
-> (Either (CycleOf f) (CycleOf f), EngineStateOf f)
recalc [(CellRef, (Maybe (String, CellType), Meta))]
inputs)) Handler
  (EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
  (Either
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> ReaderT
         (State
            (EngineState
               (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
         IO
         ())
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall a b.
ReaderT
  (State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
  IO
  a
-> (a
    -> ReaderT
         (State
            (EngineState
               (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
         IO
         b)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO ()
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall a.
IO a
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> ReaderT
      (State
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
      IO
      ())
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> IO ())
-> Either
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(CellRef,
   Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
 -> IO ())
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> IO ())
-> Either
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [(CellRef,
  Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> IO ()
forall t. UniverRecalc t => [(CellRef, CellOf t)] -> IO ()
sendResult [(CellRef,
  Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> IO ()
forall t. UniverRecalc t => [(CellRef, CellOf t)] -> IO ()
sendResult

  Cells
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     Cells
forall a.
a
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map CellAddr CellData -> Cells
Cells Map CellAddr CellData
forall a. Monoid a => a
mempty)

rpcInsertSheet :: InsertSheetParams -> Handler (EngineStateOf t) ()
rpcInsertSheet :: forall t. InsertSheetParams -> Handler (EngineStateOf t) ()
rpcInsertSheet InsertSheetParams{Int
Text
URI
insertSheet'uri :: URI
insertSheet'index :: Int
insertSheet'sheetId :: Text
insertSheet'sheetName :: Text
insertSheet'index :: InsertSheetParams -> Int
insertSheet'sheetId :: InsertSheetParams -> Text
insertSheet'sheetName :: InsertSheetParams -> Text
insertSheet'uri :: InsertSheetParams -> URI
..} =
  URI
-> ([Text] -> [Text])
-> (Map
      Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
    -> Map
         Text
         (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t.
URI
-> ([Text] -> [Text])
-> (Map Text (SheetOf t) -> Map Text (SheetOf t))
-> Handler (EngineStateOf t) ()
modifyDocument
    URI
insertSheet'uri
    (Int -> Text -> [Text] -> [Text]
forall a. Int -> a -> [a] -> [a]
insertAt Int
insertSheet'index Text
insertSheet'sheetName)
    (Text
-> Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
insertSheet'sheetName Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall a. Monoid a => a
mempty)

rpcRemoveSheet :: RemoveSheetParams -> Handler (EngineStateOf t) ()
rpcRemoveSheet :: forall t. RemoveSheetParams -> Handler (EngineStateOf t) ()
rpcRemoveSheet RemoveSheetParams{Text
URI
removeSheet'uri :: URI
removeSheet'sheetName :: Text
removeSheet'sheetName :: RemoveSheetParams -> Text
removeSheet'uri :: RemoveSheetParams -> URI
..} =
  URI
-> ([Text] -> [Text])
-> (Map Text (SheetOf t) -> Map Text (SheetOf t))
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t.
URI
-> ([Text] -> [Text])
-> (Map Text (SheetOf t) -> Map Text (SheetOf t))
-> Handler (EngineStateOf t) ()
modifyDocument
    URI
removeSheet'uri
    ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
removeSheet'sheetName))
    (Text -> Map Text (SheetOf t) -> Map Text (SheetOf t)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
removeSheet'sheetName)

rpcSetWorksheetOrder :: SetWorksheetOrderParams -> Handler (EngineStateOf t) ()
rpcSetWorksheetOrder :: forall t. SetWorksheetOrderParams -> Handler (EngineStateOf t) ()
rpcSetWorksheetOrder SetWorksheetOrderParams{Int
Text
URI
setWorksheetOrder'uri :: URI
setWorksheetOrder'sheetName :: Text
setWorksheetOrder'from :: Int
setWorksheetOrder'to :: Int
setWorksheetOrder'from :: SetWorksheetOrderParams -> Int
setWorksheetOrder'sheetName :: SetWorksheetOrderParams -> Text
setWorksheetOrder'to :: SetWorksheetOrderParams -> Int
setWorksheetOrder'uri :: SetWorksheetOrderParams -> URI
..} =
  URI
-> ([Text] -> [Text])
-> (Map Text (SheetOf t) -> Map Text (SheetOf t))
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     ()
forall t.
URI
-> ([Text] -> [Text])
-> (Map Text (SheetOf t) -> Map Text (SheetOf t))
-> Handler (EngineStateOf t) ()
modifyDocument
    URI
setWorksheetOrder'uri
    (Int -> Int -> [Text] -> [Text]
forall a. (Eq a, Show a) => Int -> Int -> [a] -> [a]
moveList Int
setWorksheetOrder'from Int
setWorksheetOrder'to)
    Map Text (SheetOf t) -> Map Text (SheetOf t)
forall a. a -> a
id

rpcSetWorksheetName
  :: UniverRecalc t => SetWorksheetNameParams -> Handler (EngineStateOf t) ()
rpcSetWorksheetName :: forall t.
UniverRecalc t =>
SetWorksheetNameParams -> Handler (EngineStateOf t) ()
rpcSetWorksheetName SetWorksheetNameParams{Text
URI
setWorksheetName'uri :: URI
setWorksheetName'sheetName :: Text
setWorksheetName'newName :: Text
setWorksheetName'newName :: SetWorksheetNameParams -> Text
setWorksheetName'sheetName :: SetWorksheetNameParams -> Text
setWorksheetName'uri :: SetWorksheetNameParams -> URI
..} = do
  URI
-> ([Text] -> [Text])
-> (Map Text (SheetOf t) -> Map Text (SheetOf t))
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     ()
forall t.
URI
-> ([Text] -> [Text])
-> (Map Text (SheetOf t) -> Map Text (SheetOf t))
-> Handler (EngineStateOf t) ()
modifyDocument
    URI
setWorksheetName'uri
    (Text -> Text -> [Text] -> [Text]
forall a. Eq a => a -> a -> [a] -> [a]
updateList Text
setWorksheetName'sheetName Text
setWorksheetName'newName)
    Map Text (SheetOf t) -> Map Text (SheetOf t)
renameSheet
  -- recompute everything & clear the whole sheet from the deps
  -- (since parsed cells may refer to the sheet)
  let sheetId :: (URI, Text)
sheetId = (URI
setWorksheetName'uri, Text
setWorksheetName'sheetName)
  Handler
  (EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
  ()
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     ()
forall engine.
ReaderT (State engine) IO () -> ReaderT (State engine) IO ()
scheduleJob
    (Handler
   (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
   ()
 -> Handler
      (EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
      ())
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     ()
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     ()
forall a b. (a -> b) -> a -> b
$ State
  (EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
  (Either
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either
        [(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
        [(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
forall engine a. State engine a -> Handler engine a
liftEngine ((EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> (Either
       [(CellRef,
         Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
       [(CellRef,
         Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
     EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either
        [(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
        [(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
forall a.
(EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> (a,
     EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> StateT
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     Identity
     a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((URI, Text)
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall env err f t e v.
(URI, Text)
-> EngineState env err f t e v -> EngineState env err f t e v
deleteSheetId (URI, Text)
sheetId) ((Either
    [(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    [(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
  EngineState
    (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> (Either
       [(CellRef,
         Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
       [(CellRef,
         Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
     EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
    -> (Either
          [(CellRef,
            Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
          [(CellRef,
            Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
        EngineState
          (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EngineState
  (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall t.
(Recalc t, Show (ErrorOf t)) =>
EngineStateOf t
-> (Either (CycleOf t) (CycleOf t), EngineStateOf t)
recalcAll))
      Handler
  (EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
  (Either
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> Handler
         (EngineState
            (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
         ())
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     ()
forall a b.
ReaderT
  (State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
  IO
  a
-> (a
    -> ReaderT
         (State
            (EngineState
               (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
         IO
         b)
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO ()
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     ()
forall a.
IO a
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> Handler
      (EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
      ())
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> IO ())
-> Either
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(CellRef,
   Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
 -> IO ())
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> IO ())
-> Either
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [(CellRef,
  Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> IO ()
forall t. UniverRecalc t => [(CellRef, CellOf t)] -> IO ()
sendResult [(CellRef,
  Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> IO ()
forall t. UniverRecalc t => [(CellRef, CellOf t)] -> IO ()
sendResult
 where
  renameSheet :: Map Text (SheetOf t) -> Map Text (SheetOf t)
renameSheet Map Text (SheetOf t)
m = case Text -> Map Text (SheetOf t) -> Maybe (SheetOf t)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
setWorksheetName'sheetName Map Text (SheetOf t)
m of
    Just SheetOf t
el -> Text -> SheetOf t -> Map Text (SheetOf t) -> Map Text (SheetOf t)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
setWorksheetName'newName SheetOf t
el (Text -> Map Text (SheetOf t) -> Map Text (SheetOf t)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Text
setWorksheetName'sheetName Map Text (SheetOf t)
m)
    Maybe (SheetOf t)
_ -> Map Text (SheetOf t)
m

rpcDefineFunction
  :: forall t
   . UniverRecalc t
  => DefineFunctionParams
  -> Handler (EngineStateOf t) (Either Text [FunctionDescription])
rpcDefineFunction :: forall t.
UniverRecalc t =>
DefineFunctionParams
-> Handler (EngineStateOf t) (Either Text [FunctionDescription])
rpcDefineFunction DefineFunctionParams{[(Text, CellRange)]
CellRange
Text
URI
defineFunction'uri :: URI
defineFunction'sheetName :: Text
defineFunction'description :: Text
defineFunction'inputs :: [(Text, CellRange)]
defineFunction'output :: CellRange
defineFunction'description :: DefineFunctionParams -> Text
defineFunction'inputs :: DefineFunctionParams -> [(Text, CellRange)]
defineFunction'output :: DefineFunctionParams -> CellRange
defineFunction'sheetName :: DefineFunctionParams -> Text
defineFunction'uri :: DefineFunctionParams -> URI
..}
  -- make sure the inputs don't overlap the output
  | [(Text, CellRange)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, CellRange)]
errors = State
  (EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
  (Either Text [FunctionDescription])
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either Text [FunctionDescription])
forall engine a. State engine a -> Handler engine a
liftEngine (State
   (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
   (Either Text [FunctionDescription])
 -> Handler
      (EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
      (Either Text [FunctionDescription]))
-> State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either Text [FunctionDescription])
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either Text [FunctionDescription])
forall a b. (a -> b) -> a -> b
$ do
      -- retrieve document to call @define@ with, modify state accordingly (@id@ when error)
      let getSheet :: Maybe
  (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     CellAddr
     (Maybe
        ((String, CellType),
         Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
getSheet = \case
            Just Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
r -> case Text
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Maybe
     (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
defineFunction'sheetName (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Map
     Text (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall err f t e v.
Document err f t e v -> Map Text (Sheet err f t e v)
sheets Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
r) of
              Just Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
x -> (Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> Maybe
      ((String, CellType),
       Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
-> Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Map
     CellAddr
     (Maybe
        ((String, CellType),
         Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Maybe
     ((String, CellType),
      Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))
forall err f t e v.
Cell err f t e v
-> Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
cell Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
x
              Maybe
  (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
_ -> Map
  CellAddr
  (Maybe
     ((String, CellType),
      Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
forall a. Monoid a => a
mempty
            Maybe
  (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
_ -> Map
  CellAddr
  (Maybe
     ((String, CellType),
      Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
forall a. Monoid a => a
mempty
      Map
  CellAddr
  (Maybe
     ((String, CellType),
      Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
sheet <- (EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> Map
      CellAddr
      (Maybe
         ((String, CellType),
          Maybe
            (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))))
-> StateT
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     Identity
     (Map
        CellAddr
        (Maybe
           ((String, CellType),
            Maybe
              (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Maybe
  (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Map
     CellAddr
     (Maybe
        ((String, CellType),
         Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
getSheet (Maybe
   (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> Map
      CellAddr
      (Maybe
         ((String, CellType),
          Maybe
            (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))))
-> (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
    -> Maybe
         (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Map
     CellAddr
     (Maybe
        ((String, CellType),
         Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Maybe
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup URI
defineFunction'uri (Map
   URI
   (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> Maybe
      (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
    -> Map
         URI
         (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Maybe
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EngineState
  (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Map
     URI
     (Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall env err f t e v.
EngineState env err f t e v -> DocumentStore err f t e v
engineDocs)
      (EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> (Either Text [FunctionDescription],
     EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either Text [FunctionDescription])
forall a.
(EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> (a,
     EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> StateT
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     Identity
     a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((EngineState
    (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
  -> (Either Text [FunctionDescription],
      EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
 -> State
      (EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
      (Either Text [FunctionDescription]))
-> (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
    -> (Either Text [FunctionDescription],
        EngineState
          (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> State
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either Text [FunctionDescription])
forall a b. (a -> b) -> a -> b
$ \EngineState
  (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
st ->
        let
          env :: EnvOf t
env = EngineState
  (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> EnvOf t
forall env err f t e v. EngineState env err f t e v -> env
engineEnv EngineState
  (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
st
          def :: EnvOf t -> Either (ErrorOf t) (EnvOf t)
def = forall t.
UniverRecalc t =>
Text
-> Map
     CellAddr
     (Maybe
        ((String, CellType),
         Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
-> [(Text, CellRange)]
-> CellRange
-> EnvOf t
-> Either (ErrorOf t) (EnvOf t)
define @t Text
defineFunction'sheetName Map
  CellAddr
  (Maybe
     ((String, CellType),
      Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))))
sheet [(Text, CellRange)]
defineFunction'inputs CellRange
defineFunction'output
        in
          case EnvOf t -> Either (ErrorOf t) (EnvOf t)
def EnvOf t
env of
            Left ErrorOf t
err ->
              let
                Annotation Text
_ Text
msg = forall t. UniverRecalc t => ErrorOf t -> Annotation
errorAnnotation @t ErrorOf t
err
              in
                (Text -> Either Text [FunctionDescription]
forall a b. a -> Either a b
Left (Text -> Either Text [FunctionDescription])
-> Text -> Either Text [FunctionDescription]
forall a b. (a -> b) -> a -> b
$ Text
"Cannot save function '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
defineFunction'sheetName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"': " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg, EngineState
  (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
st)
            Right EnvOf t
env' -> ([FunctionDescription] -> Either Text [FunctionDescription]
forall a b. b -> Either a b
Right [FunctionDescription
functionDescription], (EnvOf t -> EnvOf t)
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall env err f t e v.
(env -> env)
-> EngineState env err f t e v -> EngineState env err f t e v
mapEnv (EnvOf t -> EnvOf t -> EnvOf t
forall a b. a -> b -> a
const EnvOf t
env') EngineState
  (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
st)
  -- overlapping input(s) with output
  | Bool
otherwise =
      Either Text [FunctionDescription]
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either Text [FunctionDescription])
forall a.
a
-> ReaderT
     (State
        (EngineState
           (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
     IO
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [FunctionDescription]
 -> Handler
      (EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
      (Either Text [FunctionDescription]))
-> (Text -> Either Text [FunctionDescription])
-> Text
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either Text [FunctionDescription])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text [FunctionDescription]
forall a b. a -> Either a b
Left
        (Text
 -> Handler
      (EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
      (Either Text [FunctionDescription]))
-> Text
-> Handler
     (EngineState
        (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
     (Either Text [FunctionDescription])
forall a b. (a -> b) -> a -> b
$ ( Text
"Cannot save function '"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
defineFunction'sheetName
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' because inputs and output overlap: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Text, (String, String))] -> Text
forall a. Show a => a -> Text
showt (((Text, CellRange) -> (Text, (String, String)))
-> [(Text, CellRange)] -> [(Text, (String, String))]
forall a b. (a -> b) -> [a] -> [b]
map ((CellRange -> (String, String))
-> (Text, CellRange) -> (Text, (String, String))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((CellAddr -> String)
-> (CellAddr -> String) -> CellRange -> (String, String)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap CellAddr -> String
showExcel26 CellAddr -> String
showExcel26)) [(Text, CellRange)]
errors)
          )
 where
  functionDescription :: FunctionDescription
functionDescription =
    Text
-> FunctionType
-> Text
-> Text
-> [FunctionParameter]
-> FunctionDescription
FunctionDescription
      Text
defineFunction'sheetName
      FunctionType
User
      Text
defineFunction'description
      Text
"abstract"
      [ Text -> Text -> Text -> FunctionParameter
FunctionParameter Text
inputName Text
"example" Text
"detail"
      | (Text
inputName, CellRange
_range) <- [(Text, CellRange)]
defineFunction'inputs
      ]

  errors :: [(Text, CellRange)]
errors = ((Text, CellRange) -> Bool)
-> [(Text, CellRange)] -> [(Text, CellRange)]
forall a. (a -> Bool) -> [a] -> [a]
filter (CellRange -> CellRange -> Bool
intersects CellRange
defineFunction'output (CellRange -> Bool)
-> ((Text, CellRange) -> CellRange) -> (Text, CellRange) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, CellRange) -> CellRange
forall a b. (a, b) -> b
snd) [(Text, CellRange)]
defineFunction'inputs

  intersects :: CellRange -> CellRange -> Bool
  intersects :: CellRange -> CellRange -> Bool
intersects ((Int
x0, Int
y0), (Int
x1, Int
y1)) ((Int
x0', Int
y0'), (Int
x1', Int
y1')) =
    Bool -> Bool
not (Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x0' Bool -> Bool -> Bool
|| Int
x0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
x1' Bool -> Bool -> Bool
|| Int
y1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y0' Bool -> Bool -> Bool
|| Int
y0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y1')

{- IO & Serialisation -}

sendResult :: UniverRecalc t => [(CellRef, CellOf t)] -> IO ()
sendResult :: forall t. UniverRecalc t => [(CellRef, CellOf t)] -> IO ()
sendResult = JsonRpcRequest [(CellRef, CellData)] -> IO ()
forall a. ToJSON a => a -> IO ()
sendIO (JsonRpcRequest [(CellRef, CellData)] -> IO ())
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> JsonRpcRequest [(CellRef, CellData)])
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> [(CellRef, CellData)] -> JsonRpcRequest [(CellRef, CellData)]
forall params. String -> params -> JsonRpcRequest params
JsonRpcNotification String
"setRangeValues" ([(CellRef, CellData)] -> JsonRpcRequest [(CellRef, CellData)])
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> [(CellRef, CellData)])
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> JsonRpcRequest [(CellRef, CellData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CellRef,
  Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> (CellRef, CellData))
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> [(CellRef, CellData)]
forall a b. (a -> b) -> [a] -> [b]
map ((Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> CellData)
-> (CellRef,
    Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> (CellRef, CellData)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> CellData
forall t. UniverRecalc t => CellOf t -> CellData
packCell)

-- sendError, sendInfo :: Text -> IO ()
-- sendError = sendIO . JsonRpcNotification "error"
-- sendInfo = sendIO . JsonRpcNotification "info"

showt :: Show a => a -> Text
showt :: forall a. Show a => a -> Text
showt = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

renderPretty :: Pretty a => a -> Text
renderPretty :: forall a. Pretty a => a -> Text
renderPretty = SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream Any -> Text)
-> (a -> SimpleDocStream Any) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc Any -> SimpleDocStream Any
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions (Doc Any -> SimpleDocStream Any)
-> (a -> Doc Any) -> a -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc Any
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

packCell :: forall t. UniverRecalc t => CellOf t -> CellData
packCell :: forall t. UniverRecalc t => CellOf t -> CellData
packCell Cell{Maybe
  ((String, CellType),
   Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))
Maybe (FetchError (ErrorOf t))
Set CellRangeRef
Meta
cell :: forall err f t e v.
Cell err f t e v
-> Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
cell :: Maybe
  ((String, CellType),
   Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))
cellDeps :: Set CellRangeRef
cellError :: Maybe (FetchError (ErrorOf t))
cellMeta :: Meta
cellDeps :: forall err f t e v. Cell err f t e v -> Set CellRangeRef
cellError :: forall err f t e v. Cell err f t e v -> Maybe (FetchError err)
cellMeta :: forall err f t e v. Cell err f t e v -> Meta
..} =
  Nullable (CellStyle Maybe)
-> Nullable Text
-> Nullable Text
-> Nullable Text
-> Nullable Text
-> Nullable CustomData
-> CellData
CellData
    Nullable (CellStyle Maybe)
forall t. Nullable t
Missing
    ( case Maybe
  ((String, CellType),
   Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))
cell of
        Maybe
  ((String, CellType),
   Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))
Nothing -> Nullable Text
forall t. Nullable t
Missing
        Just ((String
_, CellType
CellValue), Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
_) -> Nullable Text
forall t. Nullable t
Missing
        Just ((String
_, CellType
CellFormula), Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
content) -> Text -> Nullable Text
forall t. t -> Nullable t
Is
          (Text -> Nullable Text) -> Text -> Nullable Text
forall a b. (a -> b) -> a -> b
$ case Maybe (FetchError (ErrorOf t))
cellError of
            Just InvalidFormula{} -> Text
"#SYNTAX"
            Just FetchError (ErrorOf t)
RefError -> Text
"#REF"
            Just SemanticError{} -> Text
"#ERROR"
            Maybe (FetchError (ErrorOf t))
Nothing -> case Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
content of
              Just (t
_term, Just ((TypeOf t, ElaborationOf t)
_typ, Just ValueOf t
val)) -> ValueOf t -> Text
forall a. Pretty a => a -> Text
renderPretty ValueOf t
val
              Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
_ -> Text
"?ERROR"
    )
    Nullable Text
forall t. Nullable t
Missing
    Nullable Text
forall t. Nullable t
Missing
    Nullable Text
forall t. Nullable t
Missing
    ( CustomData -> Nullable CustomData
forall t. t -> Nullable t
Is
        ( case (Maybe
  ((String, CellType),
   Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))
cell, Maybe (FetchError (ErrorOf t))
cellError) of
            -- given an error, set the error
            (Maybe
  ((String, CellType),
   Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))))
_, Just FetchError (ErrorOf t)
err) -> [Annotation] -> [Annotation] -> [Annotation] -> CustomData
CustomData [forall t. UniverRecalc t => FetchError (ErrorOf t) -> Annotation
fetchErrorAnnotation @t FetchError (ErrorOf t)
err] [] []
            -- given a typing, set the type annotation
            -- (regardless of whether it is a formula or value)
            (Just ((String, CellType)
_, Just (t
_, Just ((TypeOf t
ty, ElaborationOf t
_), Maybe (ValueOf t)
_))), Maybe (FetchError (ErrorOf t))
_) ->
              [Annotation] -> [Annotation] -> [Annotation] -> CustomData
CustomData [] [] [Text -> Text -> Annotation
Annotation Text
"" (TypeOf t -> Text
forall a. Pretty a => a -> Text
renderPretty TypeOf t
ty)]
            -- there should not be another state
            (Maybe
   ((String, CellType),
    Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))),
 Maybe (FetchError (ErrorOf t)))
_ -> [Annotation] -> [Annotation] -> [Annotation] -> CustomData
CustomData [] [Text -> Text -> Annotation
Annotation Text
"Invalid State" Text
"This cell is in an invalid/unknown state."] []
        )
    )

fetchErrorAnnotation :: forall t. UniverRecalc t => FetchError (ErrorOf t) -> Annotation
fetchErrorAnnotation :: forall t. UniverRecalc t => FetchError (ErrorOf t) -> Annotation
fetchErrorAnnotation = \case
  InvalidFormula ParseError
err -> Text -> Text -> Annotation
Annotation Text
"Syntax Error" (String -> Text
Text.pack (ParseError -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseError
err))
  FetchError (ErrorOf t)
RefError -> Text -> Text -> Annotation
Annotation Text
"Invalid Reference" Text
""
  SemanticError ErrorOf t
err -> forall t. UniverRecalc t => ErrorOf t -> Annotation
errorAnnotation @t ErrorOf t
err

unpackCellData :: CellData -> (Maybe (String, CellType), Meta)
unpackCellData :: CellData -> (Maybe (String, CellType), Meta)
unpackCellData CellData{Nullable Text
Nullable (CellStyle Maybe)
Nullable CustomData
cellData's :: Nullable (CellStyle Maybe)
cellData'v :: Nullable Text
cellData'f :: Nullable Text
cellData'si :: Nullable Text
cellData'p :: Nullable Text
cellData'custom :: Nullable CustomData
cellData'custom :: CellData -> Nullable CustomData
cellData'f :: CellData -> Nullable Text
cellData'p :: CellData -> Nullable Text
cellData's :: CellData -> Nullable (CellStyle Maybe)
cellData'si :: CellData -> Nullable Text
cellData'v :: CellData -> Nullable Text
..} = case (Nullable Text
cellData'f, Nullable Text
cellData'v) of
  (Is Text
f, Nullable Text
_) -> ((String, CellType) -> Maybe (String, CellType)
forall a. a -> Maybe a
Just (Text -> String
Text.unpack Text
f, CellType
CellFormula), Meta
Meta)
  (Nullable Text
_, Is Text
v) -> ((String, CellType) -> Maybe (String, CellType)
forall a. a -> Maybe a
Just (Text -> String
Text.unpack Text
v, CellType
CellValue), Meta
Meta)
  (Nullable Text, Nullable Text)
_ -> (Maybe (String, CellType)
forall a. Maybe a
Nothing, Meta
Meta)