{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

{-|
Module      : Recalc.Engine
Description : The recalculation engine for generic spreadsheet languages.

The evaluation strategy is inspired by the paper "Build systems à la carte",
it maintains a 'DocumentStore' that tracks types, values and meta data (dummied
out for now) for all cells, and a dependency graph of the cells for checking
which cells are dirty (need to be recalculated).

__References:__
  Andrey Mokhov, Neil Mitchell and Simon Peyton Jones.
  [Build Systems à la Carte](https://dl.acm.org/doi/10.1145/3236774).
  Proceedings of the ACM on Programming Languages, Volume 2, Issue ICFP.
-}
module Recalc.Engine
  ( -- * Engine Operations
    Inputs
  , CycleOf
  , ResultsOf
  , recalc
  , recalcAll
  , parseTerm

    -- * Spreadsheet Language Interface
  , Recalc (..)

    -- ** Fetch Monad
  , Fetch
  , FetchOf
  , FetchError (..)

    -- *** Actions
  , fetchType
  , fetchValue
  , throwSemanticError

    -- *** Run Action (for debugging purposes)
  , runFetchWith

    -- * Engine State
  , EngineStateOf
  , newEngineState
  , engineEnv
  , engineDocs

    -- ** State Updates
  , mapEnv
  , mapDocs
  , deleteSheetId

    -- ** Types
  , DocumentStoreOf
  , Document (..)
  , SheetOf
  , Cell (..)
  , CellOf
  , CellType (..)
  , Meta (..)

    -- ** re-export core definitions
  , module Recalc.Engine.Core
  ) where

import Build.Rebuilder (dirtyBitRebuilder)
import Build.Scheduler (Chain, restarting)
import Build.Store (Store, getInfo, getValue, initialise)
import Build.Task (Task, Tasks)

import Control.Monad ((<=<))
import Control.Monad.Except
  ( Except
  , ExceptT (..)
  , MonadError (..)
  , runExcept
  , runExceptT
  )
import Control.Monad.Reader (MonadReader (..), ReaderT (runReaderT), asks, lift)
import Data.Bifunctor (bimap, first, second)
import Data.Either (partitionEithers)
import Data.List (foldl')
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (catMaybes, isNothing)
import Data.Monoid (Endo (Endo, appEndo))
import Data.Set (Set, (\\))
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Void (Void)
import Network.URI (URI (uriPath))
import Prettyprinter hiding (column)
import Prettyprinter.Render.Text (renderStrict)
import Text.Megaparsec (MonadParsec (eof), ParseErrorBundle, Parsec, parse)

import Debug.Trace (traceShow)
import Recalc.Engine.Core
import Recalc.Engine.DependencyMap (Slow)
import Recalc.Engine.DependencyMap qualified as Deps

{- Interface -}

-- | The spreadsheet language interface. An instantiation of it can be used
-- to declare the semantics of the provided language in a spreadsheet environment.
class (Pretty t, Pretty (TypeOf t), Pretty (ElaborationOf t), Pretty (ValueOf t)) => Recalc t where
  -- | a custom environment (e.g. to bind global variables)
  type EnvOf t

  -- | a custom error type (errors during type inference, or evaluation)
  type ErrorOf t

  -- | the value @t@ evaluates to
  type ElaborationOf t

  type ElaborationOf t = t

  -- | the types of values @t@
  type TypeOf t

  -- | the value @t@ evaluates to
  type ValueOf t

  -- | the language may differentiate between cells parsed as formula and value
  parseCell :: CellType -> ReaderT SheetId (Parsec Void String) t

  -- | specify how to calculate the cell references a term depends on
  depsOf :: t -> Set CellRangeRef

  -- | specify how a term's type is inferred
  infer :: t -> FetchOf t (TypeOf t)
  infer = ((TypeOf t, ElaborationOf t) -> TypeOf t)
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t)
-> FetchOf t (TypeOf t)
forall a b.
(a -> b)
-> Fetch
     (EnvOf t) (ErrorOf t) (TypeOf t, ElaborationOf t, ValueOf t) a
-> Fetch
     (EnvOf t) (ErrorOf t) (TypeOf t, ElaborationOf t, ValueOf t) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TypeOf t, ElaborationOf t) -> TypeOf t
forall a b. (a, b) -> a
fst (Fetch
   (EnvOf t)
   (ErrorOf t)
   (TypeOf t, ElaborationOf t, ValueOf t)
   (TypeOf t, ElaborationOf t)
 -> FetchOf t (TypeOf t))
-> (t
    -> Fetch
         (EnvOf t)
         (ErrorOf t)
         (TypeOf t, ElaborationOf t, ValueOf t)
         (TypeOf t, ElaborationOf t))
-> t
-> FetchOf t (TypeOf t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t)
forall t.
Recalc t =>
t
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t)
inferElaborate

  -- | specify how a term's type is inferred with term elaboration
  -- (defaults to identity elaboration)
  inferElaborate :: t -> FetchOf t (TypeOf t, ElaborationOf t)
  default inferElaborate :: (ElaborationOf t ~ t) => t -> FetchOf t (TypeOf t, ElaborationOf t)
  inferElaborate t
t = (,t
t) (TypeOf t -> (TypeOf t, ElaborationOf t))
-> FetchOf t (TypeOf t)
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> FetchOf t (TypeOf t)
forall t. Recalc t => t -> FetchOf t (TypeOf t)
infer t
t

  -- | specify how a term is evaluated
  eval :: ElaborationOf t -> FetchOf t (ValueOf t)

  {-# MINIMAL (infer | inferElaborate), parseCell, depsOf, eval #-}

{- Engine -}

-- | The kind of information we are fetching
data Kind = Type | Value deriving (Kind -> Kind -> Bool
(Kind -> Kind -> Bool) -> (Kind -> Kind -> Bool) -> Eq Kind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Kind -> Kind -> Bool
== :: Kind -> Kind -> Bool
$c/= :: Kind -> Kind -> Bool
/= :: Kind -> Kind -> Bool
Eq, Eq Kind
Eq Kind =>
(Kind -> Kind -> Ordering)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Bool)
-> (Kind -> Kind -> Kind)
-> (Kind -> Kind -> Kind)
-> Ord Kind
Kind -> Kind -> Bool
Kind -> Kind -> Ordering
Kind -> Kind -> Kind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Kind -> Kind -> Ordering
compare :: Kind -> Kind -> Ordering
$c< :: Kind -> Kind -> Bool
< :: Kind -> Kind -> Bool
$c<= :: Kind -> Kind -> Bool
<= :: Kind -> Kind -> Bool
$c> :: Kind -> Kind -> Bool
> :: Kind -> Kind -> Bool
$c>= :: Kind -> Kind -> Bool
>= :: Kind -> Kind -> Bool
$cmax :: Kind -> Kind -> Kind
max :: Kind -> Kind -> Kind
$cmin :: Kind -> Kind -> Kind
min :: Kind -> Kind -> Kind
Ord, Int -> Kind -> ShowS
[Kind] -> ShowS
Kind -> String
(Int -> Kind -> ShowS)
-> (Kind -> String) -> ([Kind] -> ShowS) -> Show Kind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Kind -> ShowS
showsPrec :: Int -> Kind -> ShowS
$cshow :: Kind -> String
show :: Kind -> String
$cshowList :: [Kind] -> ShowS
showList :: [Kind] -> ShowS
Show)

-- | The spreadsheet engine can be queried for re-evaluation of
-- cells (types and values) and volatile results.
data Ix = CellIx !CellRef | VolatileIx
  deriving (Ix -> Ix -> Bool
(Ix -> Ix -> Bool) -> (Ix -> Ix -> Bool) -> Eq Ix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ix -> Ix -> Bool
== :: Ix -> Ix -> Bool
$c/= :: Ix -> Ix -> Bool
/= :: Ix -> Ix -> Bool
Eq, Eq Ix
Eq Ix =>
(Ix -> Ix -> Ordering)
-> (Ix -> Ix -> Bool)
-> (Ix -> Ix -> Bool)
-> (Ix -> Ix -> Bool)
-> (Ix -> Ix -> Bool)
-> (Ix -> Ix -> Ix)
-> (Ix -> Ix -> Ix)
-> Ord Ix
Ix -> Ix -> Bool
Ix -> Ix -> Ordering
Ix -> Ix -> Ix
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Ix -> Ix -> Ordering
compare :: Ix -> Ix -> Ordering
$c< :: Ix -> Ix -> Bool
< :: Ix -> Ix -> Bool
$c<= :: Ix -> Ix -> Bool
<= :: Ix -> Ix -> Bool
$c> :: Ix -> Ix -> Bool
> :: Ix -> Ix -> Bool
$c>= :: Ix -> Ix -> Bool
>= :: Ix -> Ix -> Bool
$cmax :: Ix -> Ix -> Ix
max :: Ix -> Ix -> Ix
$cmin :: Ix -> Ix -> Ix
min :: Ix -> Ix -> Ix
Ord, Int -> Ix -> ShowS
[Ix] -> ShowS
Ix -> String
(Int -> Ix -> ShowS)
-> (Ix -> String) -> ([Ix] -> ShowS) -> Show Ix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ix -> ShowS
showsPrec :: Int -> Ix -> ShowS
$cshow :: Ix -> String
show :: Ix -> String
$cshowList :: [Ix] -> ShowS
showList :: [Ix] -> ShowS
Show)

-- assume megaparsec for now
type ParseError = ParseErrorBundle String Void

-- | Evaluation of cells can always fail due to invalid formulas or refs
data FetchError err
  = InvalidFormula ParseError
  | RefError
  | SemanticError err
  deriving (FetchError err -> FetchError err -> Bool
(FetchError err -> FetchError err -> Bool)
-> (FetchError err -> FetchError err -> Bool)
-> Eq (FetchError err)
forall err. Eq err => FetchError err -> FetchError err -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall err. Eq err => FetchError err -> FetchError err -> Bool
== :: FetchError err -> FetchError err -> Bool
$c/= :: forall err. Eq err => FetchError err -> FetchError err -> Bool
/= :: FetchError err -> FetchError err -> Bool
Eq, Int -> FetchError err -> ShowS
[FetchError err] -> ShowS
FetchError err -> String
(Int -> FetchError err -> ShowS)
-> (FetchError err -> String)
-> ([FetchError err] -> ShowS)
-> Show (FetchError err)
forall err. Show err => Int -> FetchError err -> ShowS
forall err. Show err => [FetchError err] -> ShowS
forall err. Show err => FetchError err -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall err. Show err => Int -> FetchError err -> ShowS
showsPrec :: Int -> FetchError err -> ShowS
$cshow :: forall err. Show err => FetchError err -> String
show :: FetchError err -> String
$cshowList :: forall err. Show err => [FetchError err] -> ShowS
showList :: [FetchError err] -> ShowS
Show)

-- | Fetch callbacks can fail (using 'MonadError') and have access to other
-- cells (see 'fetchType', 'fetchValue'), and the custom context (using 'MonadReader')
newtype Fetch env err r a
  = Fetch
      ( forall f
         . Monad f
        => ReaderT (Ix -> ExceptT (FetchError err) f r, env) (ExceptT (FetchError err) f) a
      )
  deriving ((forall a b. (a -> b) -> Fetch env err r a -> Fetch env err r b)
-> (forall a b. a -> Fetch env err r b -> Fetch env err r a)
-> Functor (Fetch env err r)
forall a b. a -> Fetch env err r b -> Fetch env err r a
forall a b. (a -> b) -> Fetch env err r a -> Fetch env err r b
forall env err r a b. a -> Fetch env err r b -> Fetch env err r a
forall env err r a b.
(a -> b) -> Fetch env err r a -> Fetch env err r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall env err r a b.
(a -> b) -> Fetch env err r a -> Fetch env err r b
fmap :: forall a b. (a -> b) -> Fetch env err r a -> Fetch env err r b
$c<$ :: forall env err r a b. a -> Fetch env err r b -> Fetch env err r a
<$ :: forall a b. a -> Fetch env err r b -> Fetch env err r a
Functor)

type FetchOf t = Fetch (EnvOf t) (ErrorOf t) (TypeOf t, ElaborationOf t, ValueOf t)

fetch :: Ix -> Fetch env err v v
fetch :: forall env err v. Ix -> Fetch env err v v
fetch Ix
ix = (forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f v, env)
   (ExceptT (FetchError err) f)
   v)
-> Fetch env err v v
forall env err r a.
(forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
Fetch ((forall (f :: * -> *).
  Monad f =>
  ReaderT
    (Ix -> ExceptT (FetchError err) f v, env)
    (ExceptT (FetchError err) f)
    v)
 -> Fetch env err v v)
-> (forall (f :: * -> *).
    Monad f =>
    ReaderT
      (Ix -> ExceptT (FetchError err) f v, env)
      (ExceptT (FetchError err) f)
      v)
-> Fetch env err v v
forall a b. (a -> b) -> a -> b
$ ExceptT (FetchError err) f v
-> ReaderT
     (Ix -> ExceptT (FetchError err) f v, env)
     (ExceptT (FetchError err) f)
     v
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Ix -> ExceptT (FetchError err) f v, env) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT (FetchError err) f v
 -> ReaderT
      (Ix -> ExceptT (FetchError err) f v, env)
      (ExceptT (FetchError err) f)
      v)
-> ((Ix -> ExceptT (FetchError err) f v)
    -> ExceptT (FetchError err) f v)
-> (Ix -> ExceptT (FetchError err) f v)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f v, env)
     (ExceptT (FetchError err) f)
     v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ix -> ExceptT (FetchError err) f v)
-> Ix -> ExceptT (FetchError err) f v
forall a b. (a -> b) -> a -> b
$ Ix
ix) ((Ix -> ExceptT (FetchError err) f v)
 -> ReaderT
      (Ix -> ExceptT (FetchError err) f v, env)
      (ExceptT (FetchError err) f)
      v)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f v, env)
     (ExceptT (FetchError err) f)
     (Ix -> ExceptT (FetchError err) f v)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f v, env)
     (ExceptT (FetchError err) f)
     v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((Ix -> ExceptT (FetchError err) f v, env)
 -> Ix -> ExceptT (FetchError err) f v)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f v, env)
     (ExceptT (FetchError err) f)
     (Ix -> ExceptT (FetchError err) f v)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Ix -> ExceptT (FetchError err) f v, env)
-> Ix -> ExceptT (FetchError err) f v
forall a b. (a, b) -> a
fst

-- | fetch the value stored at a cell reference
fetchValue :: CellRef -> FetchOf t (ValueOf t)
fetchValue :: forall t. CellRef -> FetchOf t (ValueOf t)
fetchValue = ((TypeOf t, ElaborationOf t, ValueOf t) -> ValueOf t)
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (ValueOf t)
forall a b.
(a -> b)
-> Fetch
     (EnvOf t) (ErrorOf t) (TypeOf t, ElaborationOf t, ValueOf t) a
-> Fetch
     (EnvOf t) (ErrorOf t) (TypeOf t, ElaborationOf t, ValueOf t) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeOf t
_, ElaborationOf t
_, ValueOf t
v) -> ValueOf t
v) (Fetch
   (EnvOf t)
   (ErrorOf t)
   (TypeOf t, ElaborationOf t, ValueOf t)
   (TypeOf t, ElaborationOf t, ValueOf t)
 -> Fetch
      (EnvOf t)
      (ErrorOf t)
      (TypeOf t, ElaborationOf t, ValueOf t)
      (ValueOf t))
-> (CellRef
    -> Fetch
         (EnvOf t)
         (ErrorOf t)
         (TypeOf t, ElaborationOf t, ValueOf t)
         (TypeOf t, ElaborationOf t, ValueOf t))
-> CellRef
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (ValueOf t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ix
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
forall env err v. Ix -> Fetch env err v v
fetch (Ix
 -> Fetch
      (EnvOf t)
      (ErrorOf t)
      (TypeOf t, ElaborationOf t, ValueOf t)
      (TypeOf t, ElaborationOf t, ValueOf t))
-> (CellRef -> Ix)
-> CellRef
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellRef -> Ix
CellIx

-- | fetch the type of the value at a cell reference
fetchType :: CellRef -> FetchOf t (TypeOf t)
fetchType :: forall t. CellRef -> FetchOf t (TypeOf t)
fetchType = ((TypeOf t, ElaborationOf t, ValueOf t) -> TypeOf t)
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t)
forall a b.
(a -> b)
-> Fetch
     (EnvOf t) (ErrorOf t) (TypeOf t, ElaborationOf t, ValueOf t) a
-> Fetch
     (EnvOf t) (ErrorOf t) (TypeOf t, ElaborationOf t, ValueOf t) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TypeOf t
t, ElaborationOf t
_, ValueOf t
_) -> TypeOf t
t) (Fetch
   (EnvOf t)
   (ErrorOf t)
   (TypeOf t, ElaborationOf t, ValueOf t)
   (TypeOf t, ElaborationOf t, ValueOf t)
 -> Fetch
      (EnvOf t)
      (ErrorOf t)
      (TypeOf t, ElaborationOf t, ValueOf t)
      (TypeOf t))
-> (CellRef
    -> Fetch
         (EnvOf t)
         (ErrorOf t)
         (TypeOf t, ElaborationOf t, ValueOf t)
         (TypeOf t, ElaborationOf t, ValueOf t))
-> CellRef
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ix
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
forall env err v. Ix -> Fetch env err v v
fetch (Ix
 -> Fetch
      (EnvOf t)
      (ErrorOf t)
      (TypeOf t, ElaborationOf t, ValueOf t)
      (TypeOf t, ElaborationOf t, ValueOf t))
-> (CellRef -> Ix)
-> CellRef
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellRef -> Ix
CellIx

runFetchWith
  :: env
  -> (CellRef -> Except (FetchError err) v)
  -- ^ callback that returns a value/type (depending on its kind)
  -> Fetch env err v a
  -- ^ a fetch task to run
  -> Either (FetchError err) a
runFetchWith :: forall env err v a.
env
-> (CellRef -> Except (FetchError err) v)
-> Fetch env err v a
-> Either (FetchError err) a
runFetchWith env
env CellRef -> Except (FetchError err) v
f (Fetch forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f v, env)
  (ExceptT (FetchError err) f)
  a
v) = Except (FetchError err) a -> Either (FetchError err) a
forall e a. Except e a -> Either e a
runExcept (Except (FetchError err) a -> Either (FetchError err) a)
-> ((Ix -> Except (FetchError err) v) -> Except (FetchError err) a)
-> (Ix -> Except (FetchError err) v)
-> Either (FetchError err) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
  (Ix -> Except (FetchError err) v, env)
  (ExceptT (FetchError err) Identity)
  a
-> (Ix -> Except (FetchError err) v, env)
-> Except (FetchError err) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  (Ix -> Except (FetchError err) v, env)
  (ExceptT (FetchError err) Identity)
  a
forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f v, env)
  (ExceptT (FetchError err) f)
  a
v ((Ix -> Except (FetchError err) v, env)
 -> Except (FetchError err) a)
-> ((Ix -> Except (FetchError err) v)
    -> (Ix -> Except (FetchError err) v, env))
-> (Ix -> Except (FetchError err) v)
-> Except (FetchError err) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,env
env) ((Ix -> Except (FetchError err) v) -> Either (FetchError err) a)
-> (Ix -> Except (FetchError err) v) -> Either (FetchError err) a
forall a b. (a -> b) -> a -> b
$ \case
  CellIx CellRef
ref -> CellRef -> Except (FetchError err) v
f CellRef
ref
  Ix
_ -> FetchError err -> Except (FetchError err) v
forall a. FetchError err -> ExceptT (FetchError err) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FetchError err
forall err. FetchError err
RefError

-- Applicative instance (cannot be derived due to the higher-rank type)
instance Applicative (Fetch env err r) where
  Fetch forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  (a -> b)
f <*> :: forall a b.
Fetch env err r (a -> b) -> Fetch env err r a -> Fetch env err r b
<*> Fetch forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
x = (forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   b)
-> Fetch env err r b
forall env err r a.
(forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
Fetch (ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  (a -> b)
forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  (a -> b)
f ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  (a -> b)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     b
forall a b.
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  (a -> b)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
x)
  pure :: forall a. a -> Fetch env err r a
pure a
a = (forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
forall env err r a.
(forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
Fetch (a
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
forall a.
a
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)

-- Applicative instance (cannot be derived due to the higher-rank type)
instance Monad (Fetch env err r) where
  Fetch forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
x >>= :: forall a b.
Fetch env err r a -> (a -> Fetch env err r b) -> Fetch env err r b
>>= a -> Fetch env err r b
f = (forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   b)
-> Fetch env err r b
forall env err r a.
(forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
Fetch (ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
x ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
-> (a
    -> ReaderT
         (Ix -> ExceptT (FetchError err) f r, env)
         (ExceptT (FetchError err) f)
         b)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     b
forall a b.
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
-> (a
    -> ReaderT
         (Ix -> ExceptT (FetchError err) f r, env)
         (ExceptT (FetchError err) f)
         b)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
y' -> let Fetch forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  b
y = a -> Fetch env err r b
f a
y' in ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  b
forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  b
y)

instance MonadError (FetchError err) (Fetch env err r) where
  throwError :: forall a. FetchError err -> Fetch env err r a
throwError FetchError err
err = (forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
forall env err r a.
(forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
Fetch (FetchError err
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
forall a.
FetchError err
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FetchError err
err)
  catchError :: forall a.
Fetch env err r a
-> (FetchError err -> Fetch env err r a) -> Fetch env err r a
catchError (Fetch forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
x) FetchError err -> Fetch env err r a
handler =
    (forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
forall env err r a.
(forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
Fetch
      ((forall (f :: * -> *).
  Monad f =>
  ReaderT
    (Ix -> ExceptT (FetchError err) f r, env)
    (ExceptT (FetchError err) f)
    a)
 -> Fetch env err r a)
-> (forall (f :: * -> *).
    Monad f =>
    ReaderT
      (Ix -> ExceptT (FetchError err) f r, env)
      (ExceptT (FetchError err) f)
      a)
-> Fetch env err r a
forall a b. (a -> b) -> a -> b
$ ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
x ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
-> (FetchError err
    -> ReaderT
         (Ix -> ExceptT (FetchError err) f r, env)
         (ExceptT (FetchError err) f)
         a)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
forall a.
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
-> (FetchError err
    -> ReaderT
         (Ix -> ExceptT (FetchError err) f r, env)
         (ExceptT (FetchError err) f)
         a)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\FetchError err
e' -> let Fetch forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
e = FetchError err -> Fetch env err r a
handler FetchError err
e' in ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
e)

-- | throw user-defined error
throwSemanticError :: err -> Fetch env err r a
throwSemanticError :: forall err env r a. err -> Fetch env err r a
throwSemanticError = FetchError err -> Fetch env err r a
forall a. FetchError err -> Fetch env err r a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FetchError err -> Fetch env err r a)
-> (err -> FetchError err) -> err -> Fetch env err r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> FetchError err
forall err. err -> FetchError err
SemanticError

instance MonadReader env (Fetch env err r) where
  ask :: Fetch env err r env
ask = (forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   env)
-> Fetch env err r env
forall env err r a.
(forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
Fetch (((Ix -> ExceptT (FetchError err) f r, env) -> env)
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Ix -> ExceptT (FetchError err) f r, env) -> env
forall a b. (a, b) -> b
snd)
  local :: forall a. (env -> env) -> Fetch env err r a -> Fetch env err r a
local env -> env
f (Fetch forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
x) = (forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
forall env err r a.
(forall (f :: * -> *).
 Monad f =>
 ReaderT
   (Ix -> ExceptT (FetchError err) f r, env)
   (ExceptT (FetchError err) f)
   a)
-> Fetch env err r a
Fetch (((Ix -> ExceptT (FetchError err) f r, env)
 -> (Ix -> ExceptT (FetchError err) f r, env))
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
forall a.
((Ix -> ExceptT (FetchError err) f r, env)
 -> (Ix -> ExceptT (FetchError err) f r, env))
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
-> ReaderT
     (Ix -> ExceptT (FetchError err) f r, env)
     (ExceptT (FetchError err) f)
     a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((env -> env)
-> (Ix -> ExceptT (FetchError err) f r, env)
-> (Ix -> ExceptT (FetchError err) f r, env)
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 env -> env
f) ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f r, env)
  (ExceptT (FetchError err) f)
  a
x)

type DocumentStore err f t e v = Map URI (Document err f t e v)
type DocumentStoreOf f = DocumentStore (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)

-- a univer document
data Document err f t e v = Document
  { forall err f t e v. Document err f t e v -> [SheetName]
sheetOrder :: ![Text]
  -- ^ sheets may be re-ordered (visually)
  , forall err f t e v.
Document err f t e v -> Map SheetName (Sheet err f t e v)
sheets :: !(Map SheetName (Sheet err f t e v))
  -- ^ store of sheets by their name
  }

instance (Show err, Pretty f, Pretty t, Pretty e, Pretty v) => Show (Document err f t e v) where
  show :: Document err f t e v -> String
show Document{[SheetName]
Map SheetName (Sheet err f t e v)
sheetOrder :: forall err f t e v. Document err f t e v -> [SheetName]
sheets :: forall err f t e v.
Document err f t e v -> Map SheetName (Sheet err f t e v)
sheetOrder :: [SheetName]
sheets :: Map SheetName (Sheet err f t e v)
..} =
    String
"Document {"
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"sheetOrder = "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [SheetName] -> String
forall a. Show a => a -> String
show [SheetName]
sheetOrder
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", sheets = "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map SheetName (Map String (Cell err f t e v)) -> String
forall a. Show a => a -> String
show (Map SheetName (Sheet err f t e v)
-> Map SheetName (Map String (Cell err f t e v))
forall {k} {a}. Map k (Map (Int, Int) a) -> Map k (Map String a)
showKeys Map SheetName (Sheet err f t e v)
sheets)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"
   where
    -- make sure keys show as [Col][Row] excel-style
    showKeys :: Map k (Map (Int, Int) a) -> Map k (Map String a)
showKeys = (Map (Int, Int) a -> Map String a)
-> Map k (Map (Int, Int) a) -> Map k (Map String a)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (((Int, Int) -> String) -> Map (Int, Int) a -> Map String a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (Int, Int) -> String
showExcel26)

type Sheet err f t e v = Map CellAddr (Cell err f t e v)
type SheetOf f = Sheet (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)

type Parsed = Either ParseError

data Meta = Meta deriving (Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
(Int -> Meta -> ShowS)
-> (Meta -> String) -> ([Meta] -> ShowS) -> Show Meta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Meta -> ShowS
showsPrec :: Int -> Meta -> ShowS
$cshow :: Meta -> String
show :: Meta -> String
$cshowList :: [Meta] -> ShowS
showList :: [Meta] -> ShowS
Show)

data CellType
  = -- | cell formulas (starting with @=@)
    CellFormula
  | -- | regular values
    CellValue
  deriving (Int -> CellType -> ShowS
[CellType] -> ShowS
CellType -> String
(Int -> CellType -> ShowS)
-> (CellType -> String) -> ([CellType] -> ShowS) -> Show CellType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CellType -> ShowS
showsPrec :: Int -> CellType -> ShowS
$cshow :: CellType -> String
show :: CellType -> String
$cshowList :: [CellType] -> ShowS
showList :: [CellType] -> ShowS
Show)

data Cell err f t e v = 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 (f, Maybe ((t, e), Maybe v))))
  -- ^ a cell maybe only meta data. when it has a term (and therefore the input
  -- and celltype are available), it can have a type. if it has a type it must
  -- have an associated elaborated term, and it can have a value.
  , forall err f t e v. Cell err f t e v -> Set CellRangeRef
cellDeps :: !(Set CellRangeRef)
  -- ^ dependencies of the cell
  , forall err f t e v. Cell err f t e v -> Maybe (FetchError err)
cellError :: !(Maybe (FetchError err))
  -- ^ when the cell encounters an error (during inference or evaluation)
  , forall err f t e v. Cell err f t e v -> Meta
cellMeta :: !Meta
  -- ^ meta data (currently useless, should include style info like it once did)
  }

type CellOf f = Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)

instance (Show err, Pretty f, Pretty t, Pretty e, Pretty v) => Show (Cell err f t e v) where
  show :: Cell err f t e v -> String
show Cell{Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
Maybe (FetchError err)
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)))
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
cell :: Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
cellDeps :: Set CellRangeRef
cellError :: Maybe (FetchError err)
cellMeta :: Meta
..} =
    String
"Cell { cell = "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
-> (((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
    -> String)
-> Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"#ERR" ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v))) -> String
forall {a} {a} {a} {b}.
(Pretty a, Pretty a, Pretty a) =>
((String, b), Maybe (a, Maybe (a, Maybe a))) -> String
showCell Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
cell
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", cellDeps = "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Set CellRangeRef -> String
forall a. Show a => a -> String
show Set CellRangeRef
cellDeps
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
-> (FetchError err -> String) -> Maybe (FetchError err) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\FetchError err
e -> String
", cellError = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FetchError err -> String
forall a. Show a => a -> String
show FetchError err
e) Maybe (FetchError err)
cellError
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"
   where
    showCell :: ((String, b), Maybe (a, Maybe (a, Maybe a))) -> String
showCell ((String
s, b
_ct), Maybe (a, Maybe (a, Maybe a))
xtv) =
      String
s
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
-> ((a, Maybe (a, Maybe a)) -> String)
-> Maybe (a, Maybe (a, Maybe a))
-> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          String
""
          ( \(a
x, Maybe (a, Maybe a)
tv) ->
              String
" ("
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Pretty a => a -> String
prettyString a
x
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ((a, Maybe a) -> String) -> Maybe (a, Maybe a) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                  String
""
                  ( \(a
t, Maybe a
v') ->
                      String
": "
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Pretty a => a -> String
prettyString a
t
                        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (a -> String) -> Maybe a -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (\a
v -> String
" [↝ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Pretty a => a -> String
prettyString a
v String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") Maybe a
v'
                  )
                  Maybe (a, Maybe a)
tv
                String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
          )
          Maybe (a, Maybe (a, Maybe a))
xtv

renderPretty :: Pretty a => a -> Text
renderPretty :: forall a. Pretty a => a -> SheetName
renderPretty = SimpleDocStream Any -> SheetName
forall ann. SimpleDocStream ann -> SheetName
renderStrict (SimpleDocStream Any -> SheetName)
-> (a -> SimpleDocStream Any) -> a -> SheetName
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

prettyString :: Pretty a => a -> String
prettyString :: forall a. Pretty a => a -> String
prettyString = SheetName -> String
Text.unpack (SheetName -> String) -> (a -> SheetName) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SheetName
forall a. Pretty a => a -> SheetName
renderPretty

cellOf :: Parsed t -> Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
cellOf :: forall t.
Parsed t
-> Maybe
     (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
cellOf = \case
  Right t
t -> (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
-> Maybe
     (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
forall a. a -> Maybe a
Just (t
t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t))
forall a. Maybe a
Nothing)
  Parsed t
_ -> Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
forall a. Maybe a
Nothing

errorOf :: Parsed a -> Maybe (FetchError e)
errorOf :: forall a e. Parsed a -> Maybe (FetchError e)
errorOf = \case
  Left ParseError
err -> FetchError e -> Maybe (FetchError e)
forall a. a -> Maybe a
Just (ParseError -> FetchError e
forall err. ParseError -> FetchError err
InvalidFormula ParseError
err)
  Parsed a
_ -> Maybe (FetchError e)
forall a. Maybe a
Nothing

-- set an error
setError :: FetchError err -> Cell err f t e v -> Cell err f t e v
setError :: forall err f t e v.
FetchError err -> Cell err f t e v -> Cell err f t e v
setError FetchError err
err Cell err f t e v
c = Cell err f t e v
c{cellError = Just err}

-- set type (setting value to @Nothing@) when a term is stored
setType :: (t, e) -> Cell err f t e v -> Cell err f t e v
setType :: forall t e err f v. (t, e) -> Cell err f t e v -> Cell err f t e v
setType (t
typ, e
term) Cell err f t e v
c =
  Cell err f t e v
c
    { cell = second (fmap (second (const (Just ((typ, term), Nothing))))) <$> cell c
    , cellError = Nothing
    }

-- set value when a term and type are stored
setValue :: v -> Cell err f t e v -> Cell err f t e v
setValue :: forall v err f t e. v -> Cell err f t e v -> Cell err f t e v
setValue v
val Cell err f t e v
c =
  Cell err f t e v
c
    { cell = second (fmap (second ((,Just val) . fst <$>))) <$> cell c
    , cellError = Nothing
    }

alterCell
  :: CellRef
  -> (Maybe (Cell err f t e v) -> Maybe (Cell err f t e v))
  -> DocumentStore err f t e v
  -> DocumentStore err f t e v
alterCell :: forall err f t e v.
CellRef
-> (Maybe (Cell err f t e v) -> Maybe (Cell err f t e v))
-> DocumentStore err f t e v
-> DocumentStore err f t e v
alterCell ((URI
uri, SheetName
sheetName), (Int, Int)
ca) Maybe (Cell err f t e v) -> Maybe (Cell err f t e v)
f = ((Document err f t e v -> Maybe (Document err f t e v))
-> URI
-> Map URI (Document err f t e v)
-> Map URI (Document err f t e v)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
`Map.update` URI
uri) ((Document err f t e v -> Maybe (Document err f t e v))
 -> Map URI (Document err f t e v)
 -> Map URI (Document err f t e v))
-> (Document err f t e v -> Maybe (Document err f t e v))
-> Map URI (Document err f t e v)
-> Map URI (Document err f t e v)
forall a b. (a -> b) -> a -> b
$ \Document err f t e v
doc ->
  Document err f t e v -> Maybe (Document err f t e v)
forall a. a -> Maybe a
Just
    Document err f t e v
doc
      { sheets = ($ sheets doc) . (`Map.update` sheetName) $ \Sheet err f t e v
sheet ->
          Sheet err f t e v -> Maybe (Sheet err f t e v)
forall a. a -> Maybe a
Just ((Maybe (Cell err f t e v) -> Maybe (Cell err f t e v))
-> (Int, Int) -> Sheet err f t e v -> Sheet err f t e v
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (Cell err f t e v) -> Maybe (Cell err f t e v)
f (Int, Int)
ca Sheet err f t e v
sheet)
      }

mapCell :: (Cell err f t e v -> Cell err f t e v) -> CellRef -> Endo (DocumentStore err f t e v)
mapCell :: forall err f t e v.
(Cell err f t e v -> Cell err f t e v)
-> CellRef -> Endo (DocumentStore err f t e v)
mapCell Cell err f t e v -> Cell err f t e v
setter CellRef
ref = (DocumentStore err f t e v -> DocumentStore err f t e v)
-> Endo (DocumentStore err f t e v)
forall a. (a -> a) -> Endo a
Endo (CellRef
-> (Maybe (Cell err f t e v) -> Maybe (Cell err f t e v))
-> DocumentStore err f t e v
-> DocumentStore err f t e v
forall err f t e v.
CellRef
-> (Maybe (Cell err f t e v) -> Maybe (Cell err f t e v))
-> DocumentStore err f t e v
-> DocumentStore err f t e v
alterCell CellRef
ref (Cell err f t e v -> Maybe (Cell err f t e v)
forall a. a -> Maybe a
Just (Cell err f t e v -> Maybe (Cell err f t e v))
-> (Cell err f t e v -> Cell err f t e v)
-> Cell err f t e v
-> Maybe (Cell err f t e v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell err f t e v -> Cell err f t e v
setter =<<))

lookupCell :: CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
lookupCell :: forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
lookupCell ((URI
uri, SheetName
sheetName), (Int, Int)
ca) =
  (Int, Int)
-> Map (Int, Int) (Cell err f t e v) -> Maybe (Cell err f t e v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Int, Int)
ca (Map (Int, Int) (Cell err f t e v) -> Maybe (Cell err f t e v))
-> (Map URI (Document err f t e v)
    -> Maybe (Map (Int, Int) (Cell err f t e v)))
-> Map URI (Document err f t e v)
-> Maybe (Cell err f t e v)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< SheetName
-> Map SheetName (Map (Int, Int) (Cell err f t e v))
-> Maybe (Map (Int, Int) (Cell err f t e v))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SheetName
sheetName (Map SheetName (Map (Int, Int) (Cell err f t e v))
 -> Maybe (Map (Int, Int) (Cell err f t e v)))
-> (Document err f t e v
    -> Map SheetName (Map (Int, Int) (Cell err f t e v)))
-> Document err f t e v
-> Maybe (Map (Int, Int) (Cell err f t e v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document err f t e v
-> Map SheetName (Map (Int, Int) (Cell err f t e v))
forall err f t e v.
Document err f t e v -> Map SheetName (Sheet err f t e v)
sheets (Document err f t e v -> Maybe (Map (Int, Int) (Cell err f t e v)))
-> (Map URI (Document err f t e v) -> Maybe (Document err f t e v))
-> Map URI (Document err f t e v)
-> Maybe (Map (Int, Int) (Cell err f t e v))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< URI
-> Map URI (Document err f t e v) -> Maybe (Document err f t e v)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup URI
uri

lookupComputed :: CellRef -> DocumentStore err f t e v -> Maybe (t, e, v)
lookupComputed :: forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (t, e, v)
lookupComputed CellRef
ref DocumentStore err f t e v
ds =
  CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
lookupCell CellRef
ref DocumentStore err f t e v
ds Maybe (Cell err f t e v)
-> (Cell err f t e v -> Maybe (t, e, v)) -> Maybe (t, e, v)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Cell{cell :: forall err f t e v.
Cell err f t e v
-> Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
cell = Just ((String, CellType)
_, Just (f
_f, Just ((t
t, e
e), Just v
v)))} ->
      (t, e, v) -> Maybe (t, e, v)
forall a. a -> Maybe a
Just (t
t, e
e, v
v)
    Cell err f t e v
_ -> Maybe (t, e, v)
forall a. Maybe a
Nothing

-- lookup term
lookupCellTerm :: CellRef -> DocumentStore err f t e v -> Maybe (f, CellType)
lookupCellTerm :: forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (f, CellType)
lookupCellTerm CellRef
ref DocumentStore err f t e v
ds = do
  (CellType
ct, Maybe (f, Maybe ((t, e), Maybe v))
x) <- (((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
 -> (CellType, Maybe (f, Maybe ((t, e), Maybe v))))
-> Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
-> Maybe (CellType, Maybe (f, Maybe ((t, e), Maybe v)))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String, CellType) -> CellType)
-> ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
-> (CellType, Maybe (f, Maybe ((t, e), Maybe v)))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String, CellType) -> CellType
forall a b. (a, b) -> b
snd) (Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
 -> Maybe (CellType, Maybe (f, Maybe ((t, e), Maybe v))))
-> (Cell err f t e v
    -> Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v))))
-> Cell err f t e v
-> Maybe (CellType, Maybe (f, Maybe ((t, e), Maybe v)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cell err f t e v
-> Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
forall err f t e v.
Cell err f t e v
-> Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
cell (Cell err f t e v
 -> Maybe (CellType, Maybe (f, Maybe ((t, e), Maybe v))))
-> Maybe (Cell err f t e v)
-> Maybe (CellType, Maybe (f, Maybe ((t, e), Maybe v)))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
lookupCell CellRef
ref DocumentStore err f t e v
ds
  (,CellType
ct) (f -> (f, CellType))
-> ((f, Maybe ((t, e), Maybe v)) -> f)
-> (f, Maybe ((t, e), Maybe v))
-> (f, CellType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f, Maybe ((t, e), Maybe v)) -> f
forall a b. (a, b) -> a
fst ((f, Maybe ((t, e), Maybe v)) -> (f, CellType))
-> Maybe (f, Maybe ((t, e), Maybe v)) -> Maybe (f, CellType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f, Maybe ((t, e), Maybe v))
x

lookupCellError :: CellRef -> DocumentStore err f t e v -> Maybe (FetchError err)
lookupCellError :: forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (FetchError err)
lookupCellError CellRef
ref DocumentStore err f t e v
ds = Cell err f t e v -> Maybe (FetchError err)
forall err f t e v. Cell err f t e v -> Maybe (FetchError err)
cellError (Cell err f t e v -> Maybe (FetchError err))
-> Maybe (Cell err f t e v) -> Maybe (FetchError err)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
lookupCell CellRef
ref DocumentStore err f t e v
ds

data EngineState env err f t e v = EngineState
  { forall env err f t e v. EngineState env err f t e v -> env
engineEnv :: !env
  , forall env err f t e v. EngineState env err f t e v -> [Ix]
_engineChain :: !(Chain Ix)
  , forall env err f t e v.
EngineState env err f t e v -> DocumentStore err f t e v
engineDocs :: !(DocumentStore err f t e v)
  , forall env err f t e v. EngineState env err f t e v -> Slow CellRef
engineDeps :: !(Slow CellRef)
  }

type EngineStateOf f = EngineState (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)

instance (Show err, Pretty f, Pretty t, Pretty e, Pretty v) => Show (EngineState env err f t e v) where
  show :: EngineState env err f t e v -> String
show EngineState{engineDocs :: forall env err f t e v.
EngineState env err f t e v -> DocumentStore err f t e v
engineDocs = DocumentStore err f t e v
docs} = String
"EngineState {" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map String (Document err f t e v) -> String
forall a. Show a => a -> String
show (DocumentStore err f t e v -> Map String (Document err f t e v)
forall {a}. Map URI a -> Map String a
showKeys DocumentStore err f t e v
docs) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"
   where
    -- make sure URIs show with quotes
    showKeys :: Map URI a -> Map String a
showKeys = (URI -> String) -> Map URI a -> Map String a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys URI -> String
forall a. Show a => a -> String
show

-- | create a new engine state. the engine state is completely empty, no handles on
-- any documents.
newEngineState :: env -> EngineState env err f t e v
newEngineState :: forall env err f t e v. env -> EngineState env err f t e v
newEngineState env
env = env
-> [Ix]
-> DocumentStore err f t e v
-> Slow CellRef
-> EngineState env err f t e v
forall env err f t e v.
env
-> [Ix]
-> DocumentStore err f t e v
-> Slow CellRef
-> EngineState env err f t e v
EngineState env
env [] DocumentStore err f t e v
forall a. Monoid a => a
mempty Slow CellRef
forall a. Slow a
forall (t :: * -> *) a. DependencyMap t => t a
Deps.empty

-- | modify the custom environment
mapEnv :: (env -> env) -> EngineState env err f t e v -> EngineState env err f t e v
mapEnv :: forall env err f t e v.
(env -> env)
-> EngineState env err f t e v -> EngineState env err f t e v
mapEnv env -> env
f EngineState env err f t e v
st = EngineState env err f t e v
st{engineEnv = f (engineEnv st)}

-- | modify the document store
mapDocs
  :: (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 :: 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 DocumentStore err f t e v -> DocumentStore err f t e v
f EngineState env err f t e v
st = EngineState env err f t e v
st{engineDocs = f (engineDocs st)}

-- | delete a whole sheet by its id from the dependency graph (useful when renaming a sheet)
deleteSheetId :: SheetId -> EngineState env err f t e v -> EngineState env err f t e v
deleteSheetId :: forall env err f t e v.
(URI, SheetName)
-> EngineState env err f t e v -> EngineState env err f t e v
deleteSheetId (URI, SheetName)
sheetId EngineState env err f t e v
st = EngineState env err f t e v
st{engineDeps = Deps.deleteSheetId sheetId (engineDeps st)}

-- | inputs are given by the location, maybe an input (and its type), and meta data
type Inputs = [(CellRef, (Maybe (String, CellType), Meta))]

-- | when there is a dependency cycle, the cycle's locations are returned
-- together with the data stored there
type CycleOf t = [(CellRef, CellOf t)]

-- | the results are locations and the data stored there
type ResultsOf t = [(CellRef, CellOf t)]

-- | recalculate the whole sheet (marking everything as dirty),
-- or return the cycle if there is a dependency cycle.
recalcAll
  :: forall t
   . (Recalc t, Show (ErrorOf t))
  => EngineStateOf t
  -> (Either (CycleOf t) (ResultsOf t), EngineStateOf t)
recalcAll :: forall t.
(Recalc t, Show (ErrorOf t)) =>
EngineStateOf t
-> (Either (CycleOf t) (CycleOf t), EngineStateOf t)
recalcAll es :: EngineStateOf t
es@EngineState{DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
engineDocs :: forall env err f t e v.
EngineState env err f t e v -> DocumentStore err f t e v
engineDocs :: DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
engineDocs} =
  ((Either (CycleOf t) (CycleOf t), EngineStateOf t)
 -> (CellRef, (Maybe (String, CellType), Meta))
 -> (Either (CycleOf t) (CycleOf t), EngineStateOf t))
-> (Either (CycleOf t) (CycleOf t), EngineStateOf t)
-> [(CellRef, (Maybe (String, CellType), Meta))]
-> (Either (CycleOf t) (CycleOf t), EngineStateOf t)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(Either (CycleOf t) (CycleOf t)
_, EngineStateOf t
st) (CellRef, (Maybe (String, CellType), Meta))
input -> [(CellRef, (Maybe (String, CellType), Meta))]
-> EngineStateOf t
-> (Either (CycleOf t) (CycleOf t), EngineStateOf 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))
input] EngineStateOf t
st) (CycleOf t -> Either (CycleOf t) (CycleOf t)
forall a b. b -> Either a b
Right [], EngineStateOf t
es) [(CellRef, (Maybe (String, CellType), Meta))]
inputs
 where
  inputs :: Inputs
  inputs :: [(CellRef, (Maybe (String, CellType), Meta))]
inputs =
    [ (((URI
uri, SheetName
sheet), (Int, Int)
ca), ((String, CellType) -> Maybe (String, CellType)
forall a. a -> Maybe a
Just (String
s, CellType
ct), Meta
Meta))
    | (URI
uri, Document{[SheetName]
Map
  SheetName
  (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
sheetOrder :: forall err f t e v. Document err f t e v -> [SheetName]
sheets :: forall err f t e v.
Document err f t e v -> Map SheetName (Sheet err f t e v)
sheetOrder :: [SheetName]
sheets :: Map
  SheetName
  (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
..}) <- DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> [(URI,
     Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
forall k a. Map k a -> [(k, a)]
Map.toList DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
engineDocs
    , (SheetName
sheet, Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
sheetMap) <-
        [ (SheetName
sheet, Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
sheetMap)
        | SheetName
sheet <- [SheetName]
sheetOrder
        , Just Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
sheetMap <- [SheetName
-> Map
     SheetName
     (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 SheetName
sheet Map
  SheetName
  (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
sheets]
        ]
    , ((Int, Int)
ca, Cell{cell :: forall err f t e v.
Cell err f t e v
-> Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
cell = Just ((String
s, CellType
ct), Maybe (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
_)}) <- Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> [((Int, Int),
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
forall k a. Map k a -> [(k, a)]
Map.toList Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
sheetMap
    ]

-- | recalculate the inputs and everything that depends on those (transitively),
-- or return the cycle if there is a dependency cycle.
recalc
  :: forall f
   . (Recalc f, Show (ErrorOf f))
  => Inputs
  -> EngineStateOf f
  -> (Either (CycleOf f) (ResultsOf f), EngineStateOf f)
recalc :: 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 (EngineState EnvOf f
env [Ix]
chain DocumentStore
  (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
docs Slow CellRef
deps) =
  let
    validatedInputs :: [(CellRef, Maybe ((String, CellType), Parsed f), Meta)]
    validatedInputs :: [(CellRef, Maybe ((String, CellType), Parsed f), Meta)]
validatedInputs =
      [ (CellRef
ref, (\(String, CellType)
x -> ((String, CellType)
x, CellRef -> (String, CellType) -> Parsed f
forall t. Recalc t => CellRef -> (String, CellType) -> Parsed t
parseTerm CellRef
ref (String, CellType)
x)) ((String, CellType) -> ((String, CellType), Parsed f))
-> Maybe (String, CellType) -> Maybe ((String, CellType), Parsed f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (String, CellType)
input, Meta
meta)
      | (CellRef
ref, (Maybe (String, CellType)
input, Meta
meta)) <- [(CellRef, (Maybe (String, CellType), Meta))]
inputs
      ]

    {- compute updates -}

    -- for each parsed input at a cell-ref:
    --   * update the dependency map with the newly computed dependencies
    --   * update the document store with the new data (term, deps & error)
    --
    -- allUpdates :: [(CellRef, (Endo DepMap, Endo DocumentStore))]
    allUpdates :: [(CellRef,
  (Endo (Slow CellRef),
   Endo
     (DocumentStore
        (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))))]
allUpdates =
      [ (CellRef
ref, (Endo (Slow CellRef)
updateDepsEndo, Endo
  (DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
updateCellEndo))
      | (CellRef
ref, Maybe ((String, CellType), Parsed f)
validInput, Meta
meta) <- [(CellRef, Maybe ((String, CellType), Parsed f), Meta)]
validatedInputs
      , let
          -- validInput :: Maybe ((String, CellType), Parsed t)

          oldDeps, newDeps :: Set CellRangeRef
          oldDeps :: Set CellRangeRef
oldDeps = Set CellRangeRef
-> (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
    -> Set CellRangeRef)
-> Maybe
     (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> Set CellRangeRef
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set CellRangeRef
forall a. Monoid a => a
mempty Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> Set CellRangeRef
forall err f t e v. Cell err f t e v -> Set CellRangeRef
cellDeps (CellRef
-> DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> Maybe
     (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
lookupCell CellRef
ref DocumentStore
  (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
docs)
          newDeps :: Set CellRangeRef
newDeps = Set CellRangeRef
-> (((String, CellType), Parsed f) -> Set CellRangeRef)
-> Maybe ((String, CellType), Parsed f)
-> Set CellRangeRef
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set CellRangeRef
forall a. Monoid a => a
mempty ((f -> Set CellRangeRef) -> Parsed f -> Set CellRangeRef
forall m a. Monoid m => (a -> m) -> Either ParseError a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap f -> Set CellRangeRef
forall t. Recalc t => t -> Set CellRangeRef
depsOf (Parsed f -> Set CellRangeRef)
-> (((String, CellType), Parsed f) -> Parsed f)
-> ((String, CellType), Parsed f)
-> Set CellRangeRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, CellType), Parsed f) -> Parsed f
forall a b. (a, b) -> b
snd) Maybe ((String, CellType), Parsed f)
validInput

          updateDepsEndo :: Endo (Slow CellRef)
          updateDepsEndo :: Endo (Slow CellRef)
updateDepsEndo = (CellRef, Set CellRangeRef, Set CellRangeRef)
-> Endo (Slow CellRef)
forall ref.
Eq ref =>
(ref, Set CellRangeRef, Set CellRangeRef) -> Endo (Slow ref)
updateDeps (CellRef
ref, Set CellRangeRef
oldDeps, Set CellRangeRef
newDeps)

          -- preliminary entry for the document store
          cell :: CellOf f
          cell :: Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
cell =
            Maybe
  ((String, CellType),
   Maybe (f, Maybe ((TypeOf f, ElaborationOf f), Maybe (ValueOf f))))
-> Set CellRangeRef
-> Maybe (FetchError (ErrorOf f))
-> Meta
-> Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
forall err f t e v.
Maybe ((String, CellType), Maybe (f, Maybe ((t, e), Maybe v)))
-> Set CellRangeRef
-> Maybe (FetchError err)
-> Meta
-> Cell err f t e v
Cell
              ((Parsed f
 -> Maybe
      (f, Maybe ((TypeOf f, ElaborationOf f), Maybe (ValueOf f))))
-> ((String, CellType), Parsed f)
-> ((String, CellType),
    Maybe (f, Maybe ((TypeOf f, ElaborationOf f), Maybe (ValueOf f))))
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 Parsed f
-> Maybe
     (f, Maybe ((TypeOf f, ElaborationOf f), Maybe (ValueOf f)))
forall t.
Parsed t
-> Maybe
     (t, Maybe ((TypeOf t, ElaborationOf t), Maybe (ValueOf t)))
cellOf (((String, CellType), Parsed f)
 -> ((String, CellType),
     Maybe (f, Maybe ((TypeOf f, ElaborationOf f), Maybe (ValueOf f)))))
-> Maybe ((String, CellType), Parsed f)
-> Maybe
     ((String, CellType),
      Maybe (f, Maybe ((TypeOf f, ElaborationOf f), Maybe (ValueOf f))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ((String, CellType), Parsed f)
validInput) -- type and value are not known yet
              Set CellRangeRef
newDeps
              (Parsed f -> Maybe (FetchError (ErrorOf f))
forall a e. Parsed a -> Maybe (FetchError e)
errorOf (Parsed f -> Maybe (FetchError (ErrorOf f)))
-> (((String, CellType), Parsed f) -> Parsed f)
-> ((String, CellType), Parsed f)
-> Maybe (FetchError (ErrorOf f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, CellType), Parsed f) -> Parsed f
forall a b. (a, b) -> b
snd (((String, CellType), Parsed f) -> Maybe (FetchError (ErrorOf f)))
-> Maybe ((String, CellType), Parsed f)
-> Maybe (FetchError (ErrorOf f))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ((String, CellType), Parsed f)
validInput)
              Meta
meta

          -- entry is deleted when there is neither a term nor meta data
          updateCellEndo :: Endo (DocumentStoreOf f)
          updateCellEndo :: Endo
  (DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
updateCellEndo =
            (DocumentStore
   (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
 -> DocumentStore
      (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> Endo
     (DocumentStore
        (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall a. (a -> a) -> Endo a
Endo
              ((DocumentStore
    (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
  -> DocumentStore
       (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
 -> Endo
      (DocumentStore
         (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
-> (DocumentStore
      (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
    -> DocumentStore
         (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> Endo
     (DocumentStore
        (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall a b. (a -> b) -> a -> b
$ if Maybe ((String, CellType), Parsed f) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ((String, CellType), Parsed f)
validInput Bool -> Bool -> Bool
&& Meta -> Bool
isn't Meta
meta
                then CellRef
-> (Maybe
      (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
    -> Maybe
         (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
-> DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
forall err f t e v.
CellRef
-> (Maybe (Cell err f t e v) -> Maybe (Cell err f t e v))
-> DocumentStore err f t e v
-> DocumentStore err f t e v
alterCell CellRef
ref (Maybe (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> Maybe
     (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> Maybe
     (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall a b. a -> b -> a
const Maybe (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall a. Maybe a
Nothing)
                else CellRef
-> (Maybe
      (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
    -> Maybe
         (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
-> DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
forall err f t e v.
CellRef
-> (Maybe (Cell err f t e v) -> Maybe (Cell err f t e v))
-> DocumentStore err f t e v
-> DocumentStore err f t e v
alterCell CellRef
ref (Maybe (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> Maybe
     (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> Maybe
     (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall a b. a -> b -> a
const (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> Maybe
     (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall a. a -> Maybe a
Just Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
cell))
      ]

    -- compute new dependency map and document store
    (Endo (Slow CellRef)
depsEndo, Endo
  (DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
docsEndo) = ((CellRef,
  (Endo (Slow CellRef),
   Endo
     (DocumentStore
        (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))))
 -> (Endo (Slow CellRef),
     Endo
       (DocumentStore
          (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))))
-> [(CellRef,
     (Endo (Slow CellRef),
      Endo
        (DocumentStore
           (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))))]
-> (Endo (Slow CellRef),
    Endo
      (DocumentStore
         (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (CellRef,
 (Endo (Slow CellRef),
  Endo
    (DocumentStore
       (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))))
-> (Endo (Slow CellRef),
    Endo
      (DocumentStore
         (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
forall a b. (a, b) -> b
snd [(CellRef,
  (Endo (Slow CellRef),
   Endo
     (DocumentStore
        (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))))]
allUpdates

    deps' :: Slow CellRef
deps' = Endo (Slow CellRef) -> Slow CellRef -> Slow CellRef
forall a. Endo a -> a -> a
appEndo Endo (Slow CellRef)
depsEndo Slow CellRef
deps
    docs' :: DocumentStore
  (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
docs' = Endo
  (DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
forall a. Endo a -> a -> a
appEndo Endo
  (DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
docsEndo DocumentStore
  (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
docs

    {- determine which cells need to be recalculated -}
    cycleOrDirty :: Either [CellRef] [CellRef]
cycleOrDirty = (CellRef -> [CellRef]) -> [CellRef] -> Either [CellRef] [CellRef]
forall a. Ord a => (a -> [a]) -> [a] -> Either [a] [a]
dfs ((((URI, SheetName), CellRef) -> CellRef)
-> [((URI, SheetName), CellRef)] -> [CellRef]
forall a b. (a -> b) -> [a] -> [b]
map ((URI, SheetName), CellRef) -> CellRef
forall a b. (a, b) -> b
snd ([((URI, SheetName), CellRef)] -> [CellRef])
-> (CellRef -> [((URI, SheetName), CellRef)])
-> CellRef
-> [CellRef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slow CellRef -> CellRef -> [((URI, SheetName), CellRef)]
forall a. Slow a -> CellRef -> [((URI, SheetName), a)]
forall (t :: * -> *) a.
DependencyMap t =>
t a -> CellRef -> [((URI, SheetName), a)]
Deps.query Slow CellRef
deps') [CellRef
r | (CellRef
r, Maybe ((String, CellType), Parsed f)
_, Meta
_) <- [(CellRef, Maybe ((String, CellType), Parsed f), Meta)]
validatedInputs]

    -- annotate a cycle [CellRef] with the cells to [(CellRef, Cell)]
    withCells :: [CellRef]
-> [(CellRef,
     Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
withCells [CellRef]
refs = [Maybe
   (CellRef,
    Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
-> [(CellRef,
     Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
forall a. [Maybe a] -> [a]
catMaybes [(CellRef
ref,) (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
 -> (CellRef,
     Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
-> Maybe
     (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> Maybe
     (CellRef,
      Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CellRef
-> DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> Maybe
     (Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
lookupCell CellRef
ref DocumentStore
  (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
docs' | CellRef
ref <- [CellRef]
refs]
  in
    -- either we're done with a cyclical error, or we do the actual recalculation yielding Results
    ([CellRef]
 -> EngineState
      (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
 -> (Either
       [(CellRef,
         Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
       [(CellRef,
         Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
     EngineState
       (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
-> ([CellRef]
    -> EngineState
         (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
    -> (Either
          [(CellRef,
            Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
          [(CellRef,
            Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
        EngineState
          (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
-> Either [CellRef] [CellRef]
-> EngineState
     (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> (Either
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
    EngineState
      (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\[CellRef]
cycl -> ([(CellRef,
  Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
-> Either
     [(CellRef,
       Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
     [(CellRef,
       Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
forall a b. a -> Either a b
Left ([CellRef]
-> [(CellRef,
     Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
withCells [CellRef]
cycl),)) (\[CellRef]
dirty -> ([(CellRef,
   Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
 -> Either
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))])
-> ([(CellRef,
      Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
    EngineState
      (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
-> (Either
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
    EngineState
      (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first [(CellRef,
  Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
-> Either
     [(CellRef,
       Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
     [(CellRef,
       Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
forall a b. b -> Either a b
Right (([(CellRef,
    Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
  EngineState
    (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
 -> (Either
       [(CellRef,
         Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
       [(CellRef,
         Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
     EngineState
       (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
-> (EngineState
      (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
    -> ([(CellRef,
          Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
        EngineState
          (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
-> EngineState
     (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> (Either
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
    EngineState
      (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CellRef]
-> EngineState
     (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> ([(CellRef,
      Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
    EngineState
      (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall t.
(Recalc t, Show (ErrorOf t)) =>
[CellRef] -> EngineStateOf t -> (ResultsOf t, EngineStateOf t)
recalc' [CellRef]
dirty) Either [CellRef] [CellRef]
cycleOrDirty
      (EngineState
   (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
 -> (Either
       [(CellRef,
         Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
       [(CellRef,
         Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
     EngineState
       (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)))
-> EngineState
     (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> (Either
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))]
      [(CellRef,
        Cell (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))],
    EngineState
      (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f))
forall a b. (a -> b) -> a -> b
$ EnvOf f
-> [Ix]
-> DocumentStore
     (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
-> Slow CellRef
-> EngineState
     (EnvOf f) (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
forall env err f t e v.
env
-> [Ix]
-> DocumentStore err f t e v
-> Slow CellRef
-> EngineState env err f t e v
EngineState EnvOf f
env [Ix]
chain DocumentStore
  (ErrorOf f) f (TypeOf f) (ElaborationOf f) (ValueOf f)
docs' Slow CellRef
deps'

-- | a spreadsheet action is a monadic build task indexed by "Ix"
type Spreadsheet a = Task Monad Ix a

runFetch :: env -> Fetch env err v v -> Spreadsheet (Either (FetchError err) v)
runFetch :: forall env err v.
env -> Fetch env err v v -> Spreadsheet (Either (FetchError err) v)
runFetch env
env (Fetch forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f v, env)
  (ExceptT (FetchError err) f)
  v
x) Ix -> f (Either (FetchError err) v)
f = ExceptT (FetchError err) f v -> f (Either (FetchError err) v)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (FetchError err) f v -> f (Either (FetchError err) v))
-> ExceptT (FetchError err) f v -> f (Either (FetchError err) v)
forall a b. (a -> b) -> a -> b
$ ReaderT
  (Ix -> ExceptT (FetchError err) f v, env)
  (ExceptT (FetchError err) f)
  v
-> (Ix -> ExceptT (FetchError err) f v, env)
-> ExceptT (FetchError err) f v
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT
  (Ix -> ExceptT (FetchError err) f v, env)
  (ExceptT (FetchError err) f)
  v
forall (f :: * -> *).
Monad f =>
ReaderT
  (Ix -> ExceptT (FetchError err) f v, env)
  (ExceptT (FetchError err) f)
  v
x (f (Either (FetchError err) v) -> ExceptT (FetchError err) f v
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (f (Either (FetchError err) v) -> ExceptT (FetchError err) f v)
-> (Ix -> f (Either (FetchError err) v))
-> Ix
-> ExceptT (FetchError err) f v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ix -> f (Either (FetchError err) v)
f, env
env)

-- | a mapping from indices to potential spreadsheet actions defines our spreadsheets
type Spreadsheets a = Tasks Monad Ix a

spreadsheetsOf
  :: forall f
   . Recalc f
  => EnvOf f
  -> DocumentStoreOf f
  -> Spreadsheets (Either (FetchError (ErrorOf f)) (TypeOf f, ElaborationOf f, ValueOf f))
spreadsheetsOf :: forall f.
Recalc f =>
EnvOf f
-> DocumentStoreOf f
-> Spreadsheets
     (Either
        (FetchError (ErrorOf f)) (TypeOf f, ElaborationOf f, ValueOf f))
spreadsheetsOf EnvOf f
env DocumentStoreOf f
ds =
  (EnvOf f
-> Fetch
     (EnvOf f)
     (ErrorOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
-> forall {f :: * -> *}.
   Monad f =>
   (Ix
    -> f (Either
            (FetchError (ErrorOf f)) (TypeOf f, ElaborationOf f, ValueOf f)))
   -> f (Either
           (FetchError (ErrorOf f)) (TypeOf f, ElaborationOf f, ValueOf f))
forall env err v.
env -> Fetch env err v v -> Spreadsheet (Either (FetchError err) v)
runFetch EnvOf f
env <$>) (Maybe
   (Fetch
      (EnvOf f)
      (ErrorOf f)
      (TypeOf f, ElaborationOf f, ValueOf f)
      (TypeOf f, ElaborationOf f, ValueOf f))
 -> Maybe
      (forall {f :: * -> *}.
       Monad f =>
       (Ix
        -> f (Either
                (FetchError (ErrorOf f)) (TypeOf f, ElaborationOf f, ValueOf f)))
       -> f (Either
               (FetchError (ErrorOf f)) (TypeOf f, ElaborationOf f, ValueOf f))))
-> (Ix
    -> Maybe
         (Fetch
            (EnvOf f)
            (ErrorOf f)
            (TypeOf f, ElaborationOf f, ValueOf f)
            (TypeOf f, ElaborationOf f, ValueOf f)))
-> Ix
-> Maybe
     (forall {f :: * -> *}.
      Monad f =>
      (Ix
       -> f (Either
               (FetchError (ErrorOf f)) (TypeOf f, ElaborationOf f, ValueOf f)))
      -> f (Either
              (FetchError (ErrorOf f)) (TypeOf f, ElaborationOf f, ValueOf f)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    CellIx CellRef
ref -> f
-> Fetch
     (EnvOf f)
     (ErrorOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
forall f.
Recalc f =>
f -> FetchOf f (TypeOf f, ElaborationOf f, ValueOf f)
computeCell (f
 -> Fetch
      (EnvOf f)
      (ErrorOf f)
      (TypeOf f, ElaborationOf f, ValueOf f)
      (TypeOf f, ElaborationOf f, ValueOf f))
-> ((f, CellType) -> f)
-> (f, CellType)
-> Fetch
     (EnvOf f)
     (ErrorOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f, CellType) -> f
forall a b. (a, b) -> a
fst ((f, CellType)
 -> Fetch
      (EnvOf f)
      (ErrorOf f)
      (TypeOf f, ElaborationOf f, ValueOf f)
      (TypeOf f, ElaborationOf f, ValueOf f))
-> Maybe (f, CellType)
-> Maybe
     (Fetch
        (EnvOf f)
        (ErrorOf f)
        (TypeOf f, ElaborationOf f, ValueOf f)
        (TypeOf f, ElaborationOf f, ValueOf f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CellRef -> DocumentStoreOf f -> Maybe (f, CellType)
forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (f, CellType)
lookupCellTerm CellRef
ref DocumentStoreOf f
ds
    Ix
VolatileIx -> Fetch
  (EnvOf f)
  (ErrorOf f)
  (TypeOf f, ElaborationOf f, ValueOf f)
  (TypeOf f, ElaborationOf f, ValueOf f)
-> Maybe
     (Fetch
        (EnvOf f)
        (ErrorOf f)
        (TypeOf f, ElaborationOf f, ValueOf f)
        (TypeOf f, ElaborationOf f, ValueOf f))
forall a. a -> Maybe a
Just (FetchError (ErrorOf f)
-> Fetch
     (EnvOf f)
     (ErrorOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
forall a.
FetchError (ErrorOf f)
-> Fetch
     (EnvOf f) (ErrorOf f) (TypeOf f, ElaborationOf f, ValueOf f) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall a b. Show a => a -> b -> b
traceShow @String String
"VolatileIx ~> RefError" FetchError (ErrorOf f)
forall err. FetchError err
RefError))

computeCell :: forall f. Recalc f => f -> FetchOf f (TypeOf f, ElaborationOf f, ValueOf f)
computeCell :: forall f.
Recalc f =>
f -> FetchOf f (TypeOf f, ElaborationOf f, ValueOf f)
computeCell f
x = do
  (TypeOf f
t, ElaborationOf f
e) <- f
-> Fetch
     (EnvOf f)
     (ErrorOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
     (TypeOf f, ElaborationOf f)
forall t.
Recalc t =>
t
-> Fetch
     (EnvOf t)
     (ErrorOf t)
     (TypeOf t, ElaborationOf t, ValueOf t)
     (TypeOf t, ElaborationOf t)
inferElaborate f
x
  (TypeOf f
t,ElaborationOf f
e,) (ValueOf f -> (TypeOf f, ElaborationOf f, ValueOf f))
-> Fetch
     (EnvOf f)
     (ErrorOf f)
     (TypeOf f, ElaborationOf f, ValueOf f)
     (ValueOf f)
-> FetchOf f (TypeOf f, ElaborationOf f, ValueOf f)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Recalc t => ElaborationOf t -> FetchOf t (ValueOf t)
eval @f ElaborationOf f
e

type BuildStore err v = Store (Ix -> Bool, Chain Ix) Ix (Either (FetchError err) v)

getChain :: BuildStore err v -> Chain Ix
getChain :: forall err v. BuildStore err v -> [Ix]
getChain = (Ix -> Bool, [Ix]) -> [Ix]
forall a b. (a, b) -> b
snd ((Ix -> Bool, [Ix]) -> [Ix])
-> (Store (Ix -> Bool, [Ix]) Ix (Either (FetchError err) v)
    -> (Ix -> Bool, [Ix]))
-> Store (Ix -> Bool, [Ix]) Ix (Either (FetchError err) v)
-> [Ix]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Store (Ix -> Bool, [Ix]) Ix (Either (FetchError err) v)
-> (Ix -> Bool, [Ix])
forall i k v. Store i k v -> i
getInfo

-- | get new values (by "Kind") in "BuildStore", partitioned into @(errors, new)@
getValues :: [CellRef] -> BuildStore err v -> ([(CellRef, FetchError err)], [(CellRef, v)])
getValues :: forall err v.
[CellRef]
-> BuildStore err v
-> ([(CellRef, FetchError err)], [(CellRef, v)])
getValues [CellRef]
refs BuildStore err v
store =
  [Either (CellRef, FetchError err) (CellRef, v)]
-> ([(CellRef, FetchError err)], [(CellRef, v)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
    [(FetchError err -> (CellRef, FetchError err))
-> (v -> (CellRef, v))
-> Either (FetchError err) v
-> Either (CellRef, FetchError err) (CellRef, v)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (CellRef
ref,) (CellRef
ref,) (Ix -> BuildStore err v -> Either (FetchError err) v
forall k i v. k -> Store i k v -> v
getValue (CellRef -> Ix
CellIx CellRef
ref) BuildStore err v
store) | CellRef
ref <- [CellRef]
refs]

recalc'
  :: forall t
   . (Recalc t, Show (ErrorOf t))
  => [CellRef]
  -> EngineStateOf t
  -> (ResultsOf t, EngineStateOf t)
recalc' :: forall t.
(Recalc t, Show (ErrorOf t)) =>
[CellRef] -> EngineStateOf t -> (ResultsOf t, EngineStateOf t)
recalc' [CellRef]
dirty (EngineState EnvOf t
env [Ix]
chain DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
docs Slow CellRef
deps) =
  let
    {- recalculate dirty cells -}

    build :: Ix
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
build = Scheduler
  Monad
  (Ix -> Bool, [Ix])
  (Ix -> Bool)
  Ix
  (Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
forall ir k v. Ord k => Scheduler Monad (ir, Chain k) ir k v
restarting Rebuilder
  Monad
  (Ix -> Bool)
  Ix
  (Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
forall k v. Rebuilder Monad (k -> Bool) k v
dirtyBitRebuilder (EnvOf t
-> DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Ix
-> Maybe
     (forall {f :: * -> *}.
      Monad f =>
      (Ix
       -> f (Either
               (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)))
      -> f (Either
              (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)))
forall f.
Recalc f =>
EnvOf f
-> DocumentStoreOf f
-> Spreadsheets
     (Either
        (FetchError (ErrorOf f)) (TypeOf f, ElaborationOf f, ValueOf f))
spreadsheetsOf EnvOf t
env DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
docs)

    store :: Store
  (Ix -> Bool, [Ix])
  Ix
  (Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
store = (Ix -> Bool, [Ix])
-> (Ix
    -> Either
         (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
forall i k v. i -> (k -> v) -> Store i k v
initialise ([CellRef] -> Ix -> Bool
forall {t :: * -> *}. Foldable t => t CellRef -> Ix -> Bool
setDirty [CellRef]
dirty, [Ix]
chain) ((Ix
  -> Either
       (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
 -> Store
      (Ix -> Bool, [Ix])
      Ix
      (Either
         (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)))
-> (Ix
    -> Either
         (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
forall a b. (a -> b) -> a -> b
$ \case
      CellIx CellRef
ref
        | Just (TypeOf t, ElaborationOf t, ValueOf t)
result <- CellRef
-> DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Maybe (TypeOf t, ElaborationOf t, ValueOf t)
forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (t, e, v)
lookupComputed CellRef
ref DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
docs ->
            (TypeOf t, ElaborationOf t, ValueOf t)
-> Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)
forall a. a -> Either (FetchError (ErrorOf t)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeOf t, ElaborationOf t, ValueOf t)
result
        -- if the value cannot be found it may be invalid
        | Just FetchError (ErrorOf t)
err <- CellRef
-> DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Maybe (FetchError (ErrorOf t))
forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (FetchError err)
lookupCellError CellRef
ref DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
docs -> FetchError (ErrorOf t)
-> Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)
forall a.
FetchError (ErrorOf t) -> Either (FetchError (ErrorOf t)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FetchError (ErrorOf t)
err
        -- if there is no entry at all, it's a reference error
        | Bool
otherwise ->
            FetchError (ErrorOf t)
-> Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)
forall a.
FetchError (ErrorOf t) -> Either (FetchError (ErrorOf t)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall a b. Show a => a -> b -> b
traceShow @String (String
"ix " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show ((Int, Int) -> String
showExcel26 (CellRef -> (Int, Int)
forall a b. (a, b) -> b
snd CellRef
ref)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ~> RefError") FetchError (ErrorOf t)
forall err. FetchError err
RefError)
      Ix
VolatileIx -> String
-> Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)
forall a. HasCallStack => String -> a
error String
"not implemented"

    store' :: Store
  (Ix -> Bool, [Ix])
  Ix
  (Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
store' = (CellRef
 -> Store
      (Ix -> Bool, [Ix])
      Ix
      (Either
         (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
 -> Store
      (Ix -> Bool, [Ix])
      Ix
      (Either
         (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)))
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
-> [CellRef]
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Ix
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
build (Ix
 -> Store
      (Ix -> Bool, [Ix])
      Ix
      (Either
         (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
 -> Store
      (Ix -> Bool, [Ix])
      Ix
      (Either
         (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)))
-> (CellRef -> Ix)
-> CellRef
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellRef -> Ix
CellIx) Store
  (Ix -> Bool, [Ix])
  Ix
  (Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
store [CellRef]
dirty

    {- extract new EngineState (recalculation does not affect env nor deps) -}

    chain'' :: [Ix]
chain'' = Store
  (Ix -> Bool, [Ix])
  Ix
  (Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
-> [Ix]
forall err v. BuildStore err v -> [Ix]
getChain Store
  (Ix -> Bool, [Ix])
  Ix
  (Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
store'

    ([(CellRef, FetchError (ErrorOf t))]
errors, [(CellRef, (TypeOf t, ElaborationOf t, ValueOf t))]
successes) = [CellRef]
-> Store
     (Ix -> Bool, [Ix])
     Ix
     (Either
        (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
-> ([(CellRef, FetchError (ErrorOf t))],
    [(CellRef, (TypeOf t, ElaborationOf t, ValueOf t))])
forall err v.
[CellRef]
-> BuildStore err v
-> ([(CellRef, FetchError err)], [(CellRef, v)])
getValues [CellRef]
dirty Store
  (Ix -> Bool, [Ix])
  Ix
  (Either
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
store'

    -- update types, elaborated terms, and values followed by errors
    docs' :: DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
docs' =
      (Endo
  (DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall a. Endo a -> a -> a
`appEndo` DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
docs)
        (Endo
   (DocumentStore
      (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> DocumentStore
      (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Endo
     (DocumentStore
        (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall a b. (a -> b) -> a -> b
$ ((CellRef, FetchError (ErrorOf t))
 -> Endo
      (DocumentStore
         (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> [(CellRef, FetchError (ErrorOf t))]
-> Endo
     (DocumentStore
        (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 (\(CellRef
ref, FetchError (ErrorOf t)
e) -> (Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> CellRef
-> Endo
     (DocumentStore
        (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall err f t e v.
(Cell err f t e v -> Cell err f t e v)
-> CellRef -> Endo (DocumentStore err f t e v)
mapCell (FetchError (ErrorOf t)
-> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall err f t e v.
FetchError err -> Cell err f t e v -> Cell err f t e v
setError FetchError (ErrorOf t)
e) CellRef
ref) [(CellRef, FetchError (ErrorOf t))]
errors
          Endo
  (DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Endo
     (DocumentStore
        (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Endo
     (DocumentStore
        (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall a. Semigroup a => a -> a -> a
<> ((CellRef, (TypeOf t, ElaborationOf t, ValueOf t))
 -> Endo
      (DocumentStore
         (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> [(CellRef, (TypeOf t, ElaborationOf t, ValueOf t))]
-> Endo
     (DocumentStore
        (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
            (\(CellRef
ref, (TypeOf t
t, ElaborationOf t
e, ValueOf t
v)) -> (Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> CellRef
-> Endo
     (DocumentStore
        (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall err f t e v.
(Cell err f t e v -> Cell err f t e v)
-> CellRef -> Endo (DocumentStore err f t e v)
mapCell (ValueOf t
-> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall v err f t e. v -> Cell err f t e v -> Cell err f t e v
setValue ValueOf t
v (Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> (Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
    -> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TypeOf t, ElaborationOf t)
-> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall t e err f v. (t, e) -> Cell err f t e v -> Cell err f t e v
setType (TypeOf t
t, ElaborationOf t
e)) CellRef
ref)
            [(CellRef, (TypeOf t, ElaborationOf t, ValueOf t))]
successes

    engineState :: EngineState
  (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
engineState = EnvOf t
-> [Ix]
-> DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Slow CellRef
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall env err f t e v.
env
-> [Ix]
-> DocumentStore err f t e v
-> Slow CellRef
-> EngineState env err f t e v
EngineState EnvOf t
env [Ix]
chain'' DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
docs' Slow CellRef
deps

    -- return all recalculated cells (should get them from above)
    results :: [(CellRef,
  Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
results = [Maybe
   (CellRef,
    Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
forall a. [Maybe a] -> [a]
catMaybes [(CellRef
ref,) (Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> (CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> Maybe
     (Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Maybe
     (CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CellRef
-> DocumentStore
     (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Maybe
     (Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall err f t e v.
CellRef -> DocumentStore err f t e v -> Maybe (Cell err f t e v)
lookupCell CellRef
ref DocumentStore
  (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
docs' | CellRef
ref <- [CellRef]
dirty]
  in
    ([(CellRef,
  Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
results, EngineState
  (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
engineState)
 where
  setDirty :: t CellRef -> Ix -> Bool
setDirty t CellRef
cs = \case
    CellIx CellRef
ref -> CellRef
ref CellRef -> t CellRef -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t CellRef
cs
    VolatileIx{} -> Bool
True

-- | Given a location + its old and new dependencies, update the dependency map accordingly
updateDeps :: Eq ref => (ref, Set CellRangeRef, Set CellRangeRef) -> Endo (Slow ref)
updateDeps :: forall ref.
Eq ref =>
(ref, Set CellRangeRef, Set CellRangeRef) -> Endo (Slow ref)
updateDeps (ref
ref, Set CellRangeRef
oldDeps, Set CellRangeRef
newDeps) =
  (CellRangeRef -> Endo (Slow ref))
-> Set CellRangeRef -> Endo (Slow ref)
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (((URI, SheetName)
 -> ((Int, Int), (Int, Int)) -> ref -> Slow ref -> Slow ref)
-> CellRangeRef -> Endo (Slow ref)
alg (URI, SheetName)
-> ((Int, Int), (Int, Int)) -> ref -> Slow ref -> Slow ref
forall a.
(URI, SheetName)
-> ((Int, Int), (Int, Int)) -> a -> Slow a -> Slow a
forall (t :: * -> *) a.
DependencyMap t =>
(URI, SheetName) -> ((Int, Int), (Int, Int)) -> a -> t a -> t a
Deps.insert) (Set CellRangeRef
newDeps Set CellRangeRef -> Set CellRangeRef -> Set CellRangeRef
forall a. Ord a => Set a -> Set a -> Set a
\\ Set CellRangeRef
oldDeps) Endo (Slow ref) -> Endo (Slow ref) -> Endo (Slow ref)
forall a. Semigroup a => a -> a -> a
<> (CellRangeRef -> Endo (Slow ref))
-> Set CellRangeRef -> Endo (Slow ref)
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (((URI, SheetName)
 -> ((Int, Int), (Int, Int)) -> ref -> Slow ref -> Slow ref)
-> CellRangeRef -> Endo (Slow ref)
alg (URI, SheetName)
-> ((Int, Int), (Int, Int)) -> ref -> Slow ref -> Slow ref
forall a.
Eq a =>
(URI, SheetName)
-> ((Int, Int), (Int, Int)) -> a -> Slow a -> Slow a
forall (t :: * -> *) a.
(DependencyMap t, Eq a) =>
(URI, SheetName) -> ((Int, Int), (Int, Int)) -> a -> t a -> t a
Deps.delete) (Set CellRangeRef
oldDeps Set CellRangeRef -> Set CellRangeRef -> Set CellRangeRef
forall a. Ord a => Set a -> Set a -> Set a
\\ Set CellRangeRef
newDeps)
 where
  alg :: ((URI, SheetName)
 -> ((Int, Int), (Int, Int)) -> ref -> Slow ref -> Slow ref)
-> CellRangeRef -> Endo (Slow ref)
alg (URI, SheetName)
-> ((Int, Int), (Int, Int)) -> ref -> Slow ref -> Slow ref
dm ((URI, SheetName)
sheetId, ((Int, Int), (Int, Int))
range) = (Slow ref -> Slow ref) -> Endo (Slow ref)
forall a. (a -> a) -> Endo a
Endo ((URI, SheetName)
-> ((Int, Int), (Int, Int)) -> ref -> Slow ref -> Slow ref
dm (URI, SheetName)
sheetId ((Int, Int), (Int, Int))
range ref
ref)

-- | Compute a depth-first ordering, returns @Left@ when a cycle is detected
dfs
  :: Ord a
  => (a -> [a])
  -- ^ graph successors
  -> [a]
  -> Either [a] [a]
dfs :: forall a. Ord a => (a -> [a]) -> [a] -> Either [a] [a]
dfs a -> [a]
ds = ([[a]] -> [a]) -> Either [a] [[a]] -> Either [a] [a]
forall a b. (a -> b) -> Either [a] a -> Either [a] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Either [a] [[a]] -> Either [a] [a])
-> ([a] -> Either [a] [[a]]) -> [a] -> Either [a] [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either [a] [a]) -> [a] -> Either [a] [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([a], Set a) -> a -> Either [a] [a]
alg ([a], Set a)
forall a. Monoid a => a
mempty)
 where
  alg :: ([a], Set a) -> a -> Either [a] [a]
alg ([a]
acc, Set a
visited) a
x
    | a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
x Set a
visited = [a] -> Either [a] [a]
forall a b. a -> Either a b
Left (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)
    | let ds' :: [a]
ds' = a -> [a]
ds a
x
    , Bool -> Bool
not ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ds') =
        [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> Either [a] [[a]] -> Either [a] [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> Either [a] [a]) -> [a] -> Either [a] [[a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([a], Set a) -> a -> Either [a] [a]
alg (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc, a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
visited)) (a -> [a]
ds a
x)
    | Bool
otherwise = [a] -> Either [a] [a]
forall a b. b -> Either a b
Right (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)

-- | parse a cell (depends on the cell's location) returns formula or value (both as term)
parseTerm :: Recalc t => CellRef -> (String, CellType) -> Parsed t
parseTerm :: forall t. Recalc t => CellRef -> (String, CellType) -> Parsed t
parseTerm (sheetId :: (URI, SheetName)
sheetId@(URI
uri, SheetName
sheetName), (Int, Int)
ca) (String
str, CellType
ct) = Parsec Void String t -> String -> String -> Either ParseError t
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse (ReaderT (URI, SheetName) (Parsec Void String) t
-> (URI, SheetName) -> Parsec Void String t
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (CellType -> ReaderT (URI, SheetName) (Parsec Void String) t
forall t.
Recalc t =>
CellType -> ReaderT (URI, SheetName) (Parsec Void String) t
parseCell CellType
ct) (URI, SheetName)
sheetId Parsec Void String t
-> Parsec Void String () -> Parsec Void String t
forall a b.
Parsec Void String a
-> Parsec Void String b -> Parsec Void String a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void String ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
locStr String
str
 where
  locStr :: String
locStr = SheetName -> String
Text.unpack (SheetName
"[" SheetName -> SheetName -> SheetName
forall a. Semigroup a => a -> a -> a
<> String -> SheetName
Text.pack (URI -> String
uriPath URI
uri) SheetName -> SheetName -> SheetName
forall a. Semigroup a => a -> a -> a
<> SheetName
"]" SheetName -> SheetName -> SheetName
forall a. Semigroup a => a -> a -> a
<> SheetName
sheetName SheetName -> SheetName -> SheetName
forall a. Semigroup a => a -> a -> a
<> SheetName
"!") String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Int) -> String
showExcel26 (Int, Int)
ca

isn't :: Meta -> Bool
isn't :: Meta -> Bool
isn't Meta
_ = Bool
True