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

{-|
Module      : Recalc.Repl
Description : Utility functions for experimenting in GHCi

Provides a few utilities to experiment with the core language
to examine outcomes of parsing, type checking and inference,
evaluation and sheet recomputation.

Only the recalculation family of operations implements cell
references (only single sheeted - assumes that the current
'URI' is @\"file://repl.rc\"@, and the current 'SheetName' is
@\"Test\"@).

For an example usage of this module, refer to
[Recalc.EngineSpec](./recalc-engine-spec/Recalc-EngineSpec.html).
-}
module Recalc.Repl
  ( Result

    -- ** Parsing
  , parseFormula
  , parseValue

    -- ** Type Inference & Evaluation
  , infer
  , eval

    -- ** Spreadshheet Recalculation
  , newEngineState
  , recalc
  , evalRecalc
  , execRecalc
  --  -- * re-export
  , pretty
  ) where

import Control.Arrow (Arrow (first))
import Control.Monad.Error.Class (MonadError (throwError))
import Data.Bifunctor (bimap)
import Data.Map qualified as Map
import Data.Maybe (fromJust)
import Network.URI (URI, parseURI)
import Prettyprinter (pretty)

import Recalc.Engine hiding (eval, infer, newEngineState, recalc)

import Recalc.Engine qualified as Recalc

uri :: URI
uri :: URI
uri = Maybe URI -> URI
forall a. HasCallStack => Maybe a -> a
fromJust (String -> Maybe URI
parseURI String
"file://repl.rc")

testId :: SheetId
testId :: SheetId
testId = (URI
uri, SheetName
"Test")

type Result e = Either (FetchError e)

{- parsing -}

parseCell' :: Recalc t => CellType -> String -> Result (ErrorOf t) t
parseCell' :: forall t. Recalc t => CellType -> String -> Result (ErrorOf t) t
parseCell' CellType
k = (ParseError -> FetchError (ErrorOf t))
-> Either ParseError t -> Either (FetchError (ErrorOf t)) t
forall {t} {a} {b}. (t -> a) -> Either t b -> Either a b
mapLeft ParseError -> FetchError (ErrorOf t)
forall err. ParseError -> FetchError err
InvalidFormula (Either ParseError t -> Either (FetchError (ErrorOf t)) t)
-> (String -> Either ParseError t)
-> String
-> Either (FetchError (ErrorOf t)) t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellRef -> (String, CellType) -> Either ParseError t
forall t. Recalc t => CellRef -> (String, CellType) -> Parsed t
parseTerm (SheetId
testId, (Int
0, Int
0)) ((String, CellType) -> Either ParseError t)
-> (String -> (String, CellType)) -> String -> Either ParseError t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,CellType
k)
 where
  mapLeft :: (t -> a) -> Either t b -> Either a b
mapLeft t -> a
f = \case
    Left t
x -> a -> Either a b
forall a b. a -> Either a b
Left (t -> a
f t
x)
    Right b
y -> b -> Either a b
forall a b. b -> Either a b
Right b
y

-- | parse a formula using the specified parser
parseFormula :: Recalc t => String -> Result (ErrorOf t) t
parseFormula :: forall t. Recalc t => String -> Result (ErrorOf t) t
parseFormula = CellType -> String -> Either (FetchError (ErrorOf t)) t
forall t. Recalc t => CellType -> String -> Result (ErrorOf t) t
parseCell' CellType
CellFormula

-- | parse a value using the specified parser
parseValue :: Recalc t => String -> Result (ErrorOf t) t
parseValue :: forall t. Recalc t => String -> Result (ErrorOf t) t
parseValue = CellType -> String -> Either (FetchError (ErrorOf t)) t
forall t. Recalc t => CellType -> String -> Result (ErrorOf t) t
parseCell' CellType
CellValue

{- evaluation and type checking -}

-- | infer the type of a term under a certain context (cell references not
-- supported, use 'recalc' instead)
infer
  :: forall t
   . Recalc t
  => EnvOf t
  -- ^ custom context as specified
  -> t
  -- ^ term to infer type from
  -> Result (ErrorOf t) (TypeOf t)
  -- ^ either a type error or the inferred type
infer :: forall t. Recalc t => EnvOf t -> t -> Result (ErrorOf t) (TypeOf t)
infer EnvOf t
env t
t = forall t a. EnvOf t -> FetchOf t a -> Result (ErrorOf t) a
runFetch @t EnvOf t
env (forall t. Recalc t => t -> FetchOf t (TypeOf t)
Recalc.infer @t t
t)

-- | evaluate a term (cell references not supported, use 'recalc' instead)
eval
  :: forall t
   . Recalc t
  => EnvOf t
  -- ^ custom context as specified
  -> ElaborationOf t
  -- ^ term to evaluate
  -> Result (ErrorOf t) (ValueOf t)
eval :: forall t.
Recalc t =>
EnvOf t -> ElaborationOf t -> Result (ErrorOf t) (ValueOf t)
eval EnvOf t
env ElaborationOf t
t = forall t a. EnvOf t -> FetchOf t a -> Result (ErrorOf t) a
runFetch @t EnvOf t
env (forall t. Recalc t => ElaborationOf t -> FetchOf t (ValueOf t)
Recalc.eval @t ElaborationOf t
t)

{- spreadsheet operations -}

-- | recalculate a spreadsheet from new inputs and a engine state (see
-- 'newEngineState' to create a new one)
recalc
  :: (Recalc t, Show (ErrorOf t))
  => [(CellAddr, Maybe String)]
  -- ^ a list of inputs ('Nothing' for removing a cell)
  -> EngineStateOf t
  -- ^ the current engine state
  -> (ResultsOf t, EngineStateOf t)
  -- ^ all changed cells and their values, and the new engine state
recalc :: forall t.
(Recalc t, Show (ErrorOf t)) =>
[(CellAddr, Maybe String)]
-> EngineStateOf t -> (ResultsOf t, EngineStateOf t)
recalc [(CellAddr, Maybe String)]
inputs =
  (Either
   [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
   [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
 -> [(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (([(CellRef,
   Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
 -> [(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> [(CellRef,
         Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
-> Either
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
     [(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
forall a. HasCallStack => String -> a
error (String
 -> [(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> String)
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"cycle: " <>) (String -> String)
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    -> String)
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CellRef,
  Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> String
forall a. Show a => a -> String
show) [(CellRef,
  Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
forall a. a -> a
id)
    ((Either
    [(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
    [(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
  EngineState
    (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> ([(CellRef,
       Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
     EngineState
       (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
    -> (Either
          [(CellRef,
            Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
          [(CellRef,
            Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
        EngineState
          (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inputs
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> (Either
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
      [(CellRef,
        Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall f.
(Recalc f, Show (ErrorOf f)) =>
Inputs
-> EngineStateOf f
-> (Either (CycleOf f) (CycleOf f), EngineStateOf f)
Recalc.recalc ([(CellAddr, Maybe String)] -> Inputs
mkInputs [(CellAddr, Maybe String)]
inputs)

-- | same as 'recalc' but only returns the results
evalRecalc
  :: (Recalc t, Show (ErrorOf t))
  => [(CellAddr, Maybe String)]
  -> EngineStateOf t
  -> ResultsOf t
evalRecalc :: forall t.
(Recalc t, Show (ErrorOf t)) =>
[(CellAddr, Maybe String)] -> EngineStateOf t -> ResultsOf t
evalRecalc [(CellAddr, Maybe String)]
inputs = ([(CellRef,
   Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
 EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
forall a b. (a, b) -> a
fst (([(CellRef,
    Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
  EngineState
    (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> [(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))])
-> (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
    -> ([(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
        EngineState
          (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> [(CellRef,
     Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CellAddr, Maybe String)]
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall t.
(Recalc t, Show (ErrorOf t)) =>
[(CellAddr, Maybe String)]
-> EngineStateOf t -> (ResultsOf t, EngineStateOf t)
recalc [(CellAddr, Maybe String)]
inputs

-- | same as 'recalc' but only returns the new engine state
execRecalc
  :: (Recalc t, Show (ErrorOf t)) => [(CellAddr, Maybe String)] -> EngineStateOf t -> EngineStateOf t
execRecalc :: forall t.
(Recalc t, Show (ErrorOf t)) =>
[(CellAddr, Maybe String)] -> EngineStateOf t -> EngineStateOf t
execRecalc [(CellAddr, Maybe String)]
inputs = ([(CellRef,
   Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
 EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall a b. (a, b) -> b
snd (([(CellRef,
    Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
  EngineState
    (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
 -> EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> (EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
    -> ([(CellRef,
          Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
        EngineState
          (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)))
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CellAddr, Maybe String)]
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> ([(CellRef,
      Cell (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))],
    EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall t.
(Recalc t, Show (ErrorOf t)) =>
[(CellAddr, Maybe String)]
-> EngineStateOf t -> (ResultsOf t, EngineStateOf t)
recalc [(CellAddr, Maybe String)]
inputs

{- internal -}

runFetch :: EnvOf t -> FetchOf t a -> Result (ErrorOf t) a
runFetch :: forall t a. EnvOf t -> FetchOf t a -> Result (ErrorOf t) a
runFetch EnvOf t
env = EnvOf t
-> (CellRef
    -> Except
         (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t))
-> Fetch
     (EnvOf t) (ErrorOf t) (TypeOf t, ElaborationOf t, ValueOf t) a
-> Either (FetchError (ErrorOf t)) a
forall env err v a.
env
-> (CellRef -> Except (FetchError err) v)
-> Fetch env err v a
-> Either (FetchError err) a
runFetchWith EnvOf t
env (\CellRef
_ -> FetchError (ErrorOf t)
-> Except
     (FetchError (ErrorOf t)) (TypeOf t, ElaborationOf t, ValueOf t)
forall a.
FetchError (ErrorOf t)
-> ExceptT (FetchError (ErrorOf t)) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FetchError (ErrorOf t)
forall err. FetchError err
RefError)

-- | create a new engine state, initialising the custom context
newEngineState :: EnvOf t -> EngineStateOf t
newEngineState :: forall t. EnvOf t -> EngineStateOf t
newEngineState =
  (DocumentStore
   (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> DocumentStore
      (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall err f t e v env.
(DocumentStore err f t e v -> DocumentStore err f t e v)
-> EngineState env err f t e v -> EngineState env err f t e v
mapDocs (URI
-> Document (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 k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert URI
uri ([SheetName]
-> Map
     SheetName
     (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> Document (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall err f t e v.
[SheetName]
-> Map SheetName (Sheet err f t e v) -> Document err f t e v
Document [SheetName
sheetName] (SheetName
-> Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
-> Map
     SheetName
     (Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
forall k a. k -> a -> Map k a
Map.singleton SheetName
sheetName Sheet (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall a. Monoid a => a
mempty)))
    (EngineState
   (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
 -> EngineState
      (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> (EnvOf t
    -> EngineState
         (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t))
-> EnvOf t
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnvOf t
-> EngineState
     (EnvOf t) (ErrorOf t) t (TypeOf t) (ElaborationOf t) (ValueOf t)
forall env err f t e v. env -> EngineState env err f t e v
Recalc.newEngineState
 where
  sheetName :: SheetName
sheetName = SheetId -> SheetName
forall a b. (a, b) -> b
snd SheetId
testId

mkInputs :: [(CellAddr, Maybe String)] -> Inputs
mkInputs :: [(CellAddr, Maybe String)] -> Inputs
mkInputs = ((CellAddr, Maybe String)
 -> (CellRef, (Maybe (String, CellType), Meta)))
-> [(CellAddr, Maybe String)] -> Inputs
forall a b. (a -> b) -> [a] -> [b]
map ((CellAddr -> CellRef)
-> (Maybe String -> (Maybe (String, CellType), Meta))
-> (CellAddr, Maybe String)
-> (CellRef, (Maybe (String, CellType), Meta))
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (SheetId
testId,) Maybe String -> (Maybe (String, CellType), Meta)
alg)
 where
  alg :: Maybe String -> (Maybe (String, CellType), Meta)
alg =
    (,Meta
Meta) (Maybe (String, CellType) -> (Maybe (String, CellType), Meta))
-> (Maybe String -> Maybe (String, CellType))
-> Maybe String
-> (Maybe (String, CellType), Meta)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (String, CellType)
-> (String -> Maybe (String, CellType))
-> Maybe String
-> Maybe (String, CellType)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (String, CellType)
forall a. Maybe a
Nothing \case
      s :: String
s@(Char
'=' : String
_) -> (String, CellType) -> Maybe (String, CellType)
forall a. a -> Maybe a
Just (String
s, CellType
CellFormula)
      String
s -> (String, CellType) -> Maybe (String, CellType)
forall a. a -> Maybe a
Just (String
s, CellType
CellValue)