{-# LANGUAGE DataKinds #-}

{-|
Module      : Recalc.Server.Protocol where
Description : Named protocol implementation for the JSON-RPC api.
-}
module Recalc.Univer.Protocol where

import Control.Arrow (first, second)
import Data.Aeson qualified as Json
import Data.Function (on)
import Data.List (groupBy, sortOn)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Text (Text)
import GHC.Generics (Generic)
import Network.URI

import Recalc.Engine
import Recalc.Server

data SpreadsheetProtocol mode = SpreadsheetProtocol
  { forall {k} (mode :: k).
SpreadsheetProtocol mode -> mode :- JsonRpc "open" OpenParams ()
rpcOpen :: mode :- JsonRpc "open" OpenParams ()
  , forall {k} (mode :: k).
SpreadsheetProtocol mode -> mode :- JsonRpc "save" SaveParams ()
rpcSave :: mode :- JsonRpc "save" SaveParams ()
  , forall {k} (mode :: k).
SpreadsheetProtocol mode -> mode :- JsonRpc "close" CloseParams ()
rpcClose :: mode :- JsonRpc "close" CloseParams ()
  , forall {k} (mode :: k).
SpreadsheetProtocol mode
-> mode :- JsonRpc "setRangeValues" SetRangeValuesParams Cells
rpcSetRangeValues :: mode :- JsonRpc "setRangeValues" SetRangeValuesParams Cells
  , forall {k} (mode :: k).
SpreadsheetProtocol mode
-> mode :- JsonRpc "insertSheet" InsertSheetParams ()
rpcInsertSheet :: mode :- JsonRpc "insertSheet" InsertSheetParams ()
  , forall {k} (mode :: k).
SpreadsheetProtocol mode
-> mode :- JsonRpc "removeSheet" RemoveSheetParams ()
rpcRemoveSheet :: mode :- JsonRpc "removeSheet" RemoveSheetParams ()
  , forall {k} (mode :: k).
SpreadsheetProtocol mode
-> mode :- JsonRpc "setWorksheetOrder" SetWorksheetOrderParams ()
rpcSetWorksheetOrder :: mode :- JsonRpc "setWorksheetOrder" SetWorksheetOrderParams ()
  , forall {k} (mode :: k).
SpreadsheetProtocol mode
-> mode :- JsonRpc "setWorksheetName" SetWorksheetNameParams ()
rpcSetWorksheetName :: mode :- JsonRpc "setWorksheetName" SetWorksheetNameParams ()
  , forall {k} (mode :: k).
SpreadsheetProtocol mode
-> mode
   :- JsonRpc
        "defineFunction"
        DefineFunctionParams
        (Either Text [FunctionDescription])
rpcDefineFunction
      :: mode :- JsonRpc "defineFunction" DefineFunctionParams (Either Text [FunctionDescription])
  }
  deriving ((forall x.
 SpreadsheetProtocol mode -> Rep (SpreadsheetProtocol mode) x)
-> (forall x.
    Rep (SpreadsheetProtocol mode) x -> SpreadsheetProtocol mode)
-> Generic (SpreadsheetProtocol mode)
forall x.
Rep (SpreadsheetProtocol mode) x -> SpreadsheetProtocol mode
forall x.
SpreadsheetProtocol mode -> Rep (SpreadsheetProtocol mode) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (mode :: k) x.
Rep (SpreadsheetProtocol mode) x -> SpreadsheetProtocol mode
forall k (mode :: k) x.
SpreadsheetProtocol mode -> Rep (SpreadsheetProtocol mode) x
$cfrom :: forall k (mode :: k) x.
SpreadsheetProtocol mode -> Rep (SpreadsheetProtocol mode) x
from :: forall x.
SpreadsheetProtocol mode -> Rep (SpreadsheetProtocol mode) x
$cto :: forall k (mode :: k) x.
Rep (SpreadsheetProtocol mode) x -> SpreadsheetProtocol mode
to :: forall x.
Rep (SpreadsheetProtocol mode) x -> SpreadsheetProtocol mode
Generic)

data OpenParams = OpenParams
  { OpenParams -> URI
open'uri :: URI
  , OpenParams -> [Text]
open'sheetOrder :: [Text]
  }
  deriving (Int -> OpenParams -> ShowS
[OpenParams] -> ShowS
OpenParams -> String
(Int -> OpenParams -> ShowS)
-> (OpenParams -> String)
-> ([OpenParams] -> ShowS)
-> Show OpenParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenParams -> ShowS
showsPrec :: Int -> OpenParams -> ShowS
$cshow :: OpenParams -> String
show :: OpenParams -> String
$cshowList :: [OpenParams] -> ShowS
showList :: [OpenParams] -> ShowS
Show, (forall x. OpenParams -> Rep OpenParams x)
-> (forall x. Rep OpenParams x -> OpenParams) -> Generic OpenParams
forall x. Rep OpenParams x -> OpenParams
forall x. OpenParams -> Rep OpenParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OpenParams -> Rep OpenParams x
from :: forall x. OpenParams -> Rep OpenParams x
$cto :: forall x. Rep OpenParams x -> OpenParams
to :: forall x. Rep OpenParams x -> OpenParams
Generic)

data SaveParams = SaveParams {SaveParams -> URI
save'uri :: URI, SaveParams -> URI
save'asUri :: URI}
  deriving ((forall x. SaveParams -> Rep SaveParams x)
-> (forall x. Rep SaveParams x -> SaveParams) -> Generic SaveParams
forall x. Rep SaveParams x -> SaveParams
forall x. SaveParams -> Rep SaveParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SaveParams -> Rep SaveParams x
from :: forall x. SaveParams -> Rep SaveParams x
$cto :: forall x. Rep SaveParams x -> SaveParams
to :: forall x. Rep SaveParams x -> SaveParams
Generic, Int -> SaveParams -> ShowS
[SaveParams] -> ShowS
SaveParams -> String
(Int -> SaveParams -> ShowS)
-> (SaveParams -> String)
-> ([SaveParams] -> ShowS)
-> Show SaveParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SaveParams -> ShowS
showsPrec :: Int -> SaveParams -> ShowS
$cshow :: SaveParams -> String
show :: SaveParams -> String
$cshowList :: [SaveParams] -> ShowS
showList :: [SaveParams] -> ShowS
Show)

newtype CloseParams = CloseParams {CloseParams -> URI
close'uri :: URI}
  deriving ((forall x. CloseParams -> Rep CloseParams x)
-> (forall x. Rep CloseParams x -> CloseParams)
-> Generic CloseParams
forall x. Rep CloseParams x -> CloseParams
forall x. CloseParams -> Rep CloseParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CloseParams -> Rep CloseParams x
from :: forall x. CloseParams -> Rep CloseParams x
$cto :: forall x. Rep CloseParams x -> CloseParams
to :: forall x. Rep CloseParams x -> CloseParams
Generic, Int -> CloseParams -> ShowS
[CloseParams] -> ShowS
CloseParams -> String
(Int -> CloseParams -> ShowS)
-> (CloseParams -> String)
-> ([CloseParams] -> ShowS)
-> Show CloseParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloseParams -> ShowS
showsPrec :: Int -> CloseParams -> ShowS
$cshow :: CloseParams -> String
show :: CloseParams -> String
$cshowList :: [CloseParams] -> ShowS
showList :: [CloseParams] -> ShowS
Show)

data SetRangeValuesParams = SetRangeValuesParams
  { SetRangeValuesParams -> URI
setRangeValues'uri :: URI
  , SetRangeValuesParams -> Text
setRangeValues'sheetName :: Text
  , SetRangeValuesParams -> Cells
setRangeValues'cells :: Cells
  }
  deriving ((forall x. SetRangeValuesParams -> Rep SetRangeValuesParams x)
-> (forall x. Rep SetRangeValuesParams x -> SetRangeValuesParams)
-> Generic SetRangeValuesParams
forall x. Rep SetRangeValuesParams x -> SetRangeValuesParams
forall x. SetRangeValuesParams -> Rep SetRangeValuesParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetRangeValuesParams -> Rep SetRangeValuesParams x
from :: forall x. SetRangeValuesParams -> Rep SetRangeValuesParams x
$cto :: forall x. Rep SetRangeValuesParams x -> SetRangeValuesParams
to :: forall x. Rep SetRangeValuesParams x -> SetRangeValuesParams
Generic, Int -> SetRangeValuesParams -> ShowS
[SetRangeValuesParams] -> ShowS
SetRangeValuesParams -> String
(Int -> SetRangeValuesParams -> ShowS)
-> (SetRangeValuesParams -> String)
-> ([SetRangeValuesParams] -> ShowS)
-> Show SetRangeValuesParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetRangeValuesParams -> ShowS
showsPrec :: Int -> SetRangeValuesParams -> ShowS
$cshow :: SetRangeValuesParams -> String
show :: SetRangeValuesParams -> String
$cshowList :: [SetRangeValuesParams] -> ShowS
showList :: [SetRangeValuesParams] -> ShowS
Show)

data InsertSheetParams = InsertSheetParams
  { InsertSheetParams -> URI
insertSheet'uri :: URI
  , InsertSheetParams -> Int
insertSheet'index :: Int
  , InsertSheetParams -> Text
insertSheet'sheetId :: Text
  , InsertSheetParams -> Text
insertSheet'sheetName :: Text
  }
  deriving (Int -> InsertSheetParams -> ShowS
[InsertSheetParams] -> ShowS
InsertSheetParams -> String
(Int -> InsertSheetParams -> ShowS)
-> (InsertSheetParams -> String)
-> ([InsertSheetParams] -> ShowS)
-> Show InsertSheetParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InsertSheetParams -> ShowS
showsPrec :: Int -> InsertSheetParams -> ShowS
$cshow :: InsertSheetParams -> String
show :: InsertSheetParams -> String
$cshowList :: [InsertSheetParams] -> ShowS
showList :: [InsertSheetParams] -> ShowS
Show, (forall x. InsertSheetParams -> Rep InsertSheetParams x)
-> (forall x. Rep InsertSheetParams x -> InsertSheetParams)
-> Generic InsertSheetParams
forall x. Rep InsertSheetParams x -> InsertSheetParams
forall x. InsertSheetParams -> Rep InsertSheetParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InsertSheetParams -> Rep InsertSheetParams x
from :: forall x. InsertSheetParams -> Rep InsertSheetParams x
$cto :: forall x. Rep InsertSheetParams x -> InsertSheetParams
to :: forall x. Rep InsertSheetParams x -> InsertSheetParams
Generic)

data RemoveSheetParams = RemoveSheetParams
  { RemoveSheetParams -> URI
removeSheet'uri :: URI
  , RemoveSheetParams -> Text
removeSheet'sheetName :: Text
  }
  deriving (Int -> RemoveSheetParams -> ShowS
[RemoveSheetParams] -> ShowS
RemoveSheetParams -> String
(Int -> RemoveSheetParams -> ShowS)
-> (RemoveSheetParams -> String)
-> ([RemoveSheetParams] -> ShowS)
-> Show RemoveSheetParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoveSheetParams -> ShowS
showsPrec :: Int -> RemoveSheetParams -> ShowS
$cshow :: RemoveSheetParams -> String
show :: RemoveSheetParams -> String
$cshowList :: [RemoveSheetParams] -> ShowS
showList :: [RemoveSheetParams] -> ShowS
Show, (forall x. RemoveSheetParams -> Rep RemoveSheetParams x)
-> (forall x. Rep RemoveSheetParams x -> RemoveSheetParams)
-> Generic RemoveSheetParams
forall x. Rep RemoveSheetParams x -> RemoveSheetParams
forall x. RemoveSheetParams -> Rep RemoveSheetParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RemoveSheetParams -> Rep RemoveSheetParams x
from :: forall x. RemoveSheetParams -> Rep RemoveSheetParams x
$cto :: forall x. Rep RemoveSheetParams x -> RemoveSheetParams
to :: forall x. Rep RemoveSheetParams x -> RemoveSheetParams
Generic)

data SetWorksheetOrderParams = SetWorksheetOrderParams
  { SetWorksheetOrderParams -> URI
setWorksheetOrder'uri :: URI
  , SetWorksheetOrderParams -> Text
setWorksheetOrder'sheetName :: Text
  , SetWorksheetOrderParams -> Int
setWorksheetOrder'from :: Int
  , SetWorksheetOrderParams -> Int
setWorksheetOrder'to :: Int
  }
  deriving (Int -> SetWorksheetOrderParams -> ShowS
[SetWorksheetOrderParams] -> ShowS
SetWorksheetOrderParams -> String
(Int -> SetWorksheetOrderParams -> ShowS)
-> (SetWorksheetOrderParams -> String)
-> ([SetWorksheetOrderParams] -> ShowS)
-> Show SetWorksheetOrderParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetWorksheetOrderParams -> ShowS
showsPrec :: Int -> SetWorksheetOrderParams -> ShowS
$cshow :: SetWorksheetOrderParams -> String
show :: SetWorksheetOrderParams -> String
$cshowList :: [SetWorksheetOrderParams] -> ShowS
showList :: [SetWorksheetOrderParams] -> ShowS
Show, (forall x.
 SetWorksheetOrderParams -> Rep SetWorksheetOrderParams x)
-> (forall x.
    Rep SetWorksheetOrderParams x -> SetWorksheetOrderParams)
-> Generic SetWorksheetOrderParams
forall x. Rep SetWorksheetOrderParams x -> SetWorksheetOrderParams
forall x. SetWorksheetOrderParams -> Rep SetWorksheetOrderParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetWorksheetOrderParams -> Rep SetWorksheetOrderParams x
from :: forall x. SetWorksheetOrderParams -> Rep SetWorksheetOrderParams x
$cto :: forall x. Rep SetWorksheetOrderParams x -> SetWorksheetOrderParams
to :: forall x. Rep SetWorksheetOrderParams x -> SetWorksheetOrderParams
Generic)

instance Json.FromJSON SetWorksheetOrderParams where
  parseJSON :: Value -> Parser SetWorksheetOrderParams
parseJSON = Options -> Value -> Parser SetWorksheetOrderParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

data SetWorksheetNameParams = SetWorksheetNameParams
  { SetWorksheetNameParams -> URI
setWorksheetName'uri :: URI
  , SetWorksheetNameParams -> Text
setWorksheetName'sheetName :: Text
  , SetWorksheetNameParams -> Text
setWorksheetName'newName :: Text
  }
  deriving (Int -> SetWorksheetNameParams -> ShowS
[SetWorksheetNameParams] -> ShowS
SetWorksheetNameParams -> String
(Int -> SetWorksheetNameParams -> ShowS)
-> (SetWorksheetNameParams -> String)
-> ([SetWorksheetNameParams] -> ShowS)
-> Show SetWorksheetNameParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetWorksheetNameParams -> ShowS
showsPrec :: Int -> SetWorksheetNameParams -> ShowS
$cshow :: SetWorksheetNameParams -> String
show :: SetWorksheetNameParams -> String
$cshowList :: [SetWorksheetNameParams] -> ShowS
showList :: [SetWorksheetNameParams] -> ShowS
Show, (forall x. SetWorksheetNameParams -> Rep SetWorksheetNameParams x)
-> (forall x.
    Rep SetWorksheetNameParams x -> SetWorksheetNameParams)
-> Generic SetWorksheetNameParams
forall x. Rep SetWorksheetNameParams x -> SetWorksheetNameParams
forall x. SetWorksheetNameParams -> Rep SetWorksheetNameParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetWorksheetNameParams -> Rep SetWorksheetNameParams x
from :: forall x. SetWorksheetNameParams -> Rep SetWorksheetNameParams x
$cto :: forall x. Rep SetWorksheetNameParams x -> SetWorksheetNameParams
to :: forall x. Rep SetWorksheetNameParams x -> SetWorksheetNameParams
Generic)

data DefineFunctionParams = DefineFunctionParams
  { DefineFunctionParams -> URI
defineFunction'uri :: URI
  , DefineFunctionParams -> Text
defineFunction'sheetName :: Text
  , DefineFunctionParams -> Text
defineFunction'description :: Text
  , DefineFunctionParams -> [(Text, CellRange)]
defineFunction'inputs :: [(Text, CellRange)]
  , DefineFunctionParams -> CellRange
defineFunction'output :: CellRange
  }
  deriving (Int -> DefineFunctionParams -> ShowS
[DefineFunctionParams] -> ShowS
DefineFunctionParams -> String
(Int -> DefineFunctionParams -> ShowS)
-> (DefineFunctionParams -> String)
-> ([DefineFunctionParams] -> ShowS)
-> Show DefineFunctionParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefineFunctionParams -> ShowS
showsPrec :: Int -> DefineFunctionParams -> ShowS
$cshow :: DefineFunctionParams -> String
show :: DefineFunctionParams -> String
$cshowList :: [DefineFunctionParams] -> ShowS
showList :: [DefineFunctionParams] -> ShowS
Show, (forall x. DefineFunctionParams -> Rep DefineFunctionParams x)
-> (forall x. Rep DefineFunctionParams x -> DefineFunctionParams)
-> Generic DefineFunctionParams
forall x. Rep DefineFunctionParams x -> DefineFunctionParams
forall x. DefineFunctionParams -> Rep DefineFunctionParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DefineFunctionParams -> Rep DefineFunctionParams x
from :: forall x. DefineFunctionParams -> Rep DefineFunctionParams x
$cto :: forall x. Rep DefineFunctionParams x -> DefineFunctionParams
to :: forall x. Rep DefineFunctionParams x -> DefineFunctionParams
Generic)

-- | as defined in @\@univerjs/engine-formula#basics/function.ts@
data FunctionType
  = -- | Financial Functions
    Financial
  | -- | Date and Time Functions
    Date
  | -- | Math and Trigonometry Functions
    Math
  | -- | Statistical Functions
    Statistical
  | -- | Lookup and Reference Functions
    Lookup
  | -- | Database Functions
    Database
  | -- | Text Functions
    Text
  | -- | Logical Functions
    Logical
  | -- | Information Functions
    Information
  | -- | Engineering Functions
    Engineering
  | -- | Cube Functions
    Cube
  | -- | Compatibility Functions
    Compatibility
  | -- | Web Functions
    Web
  | -- | Array Functions
    Array
  | -- | Univer-specific functions
    Univer
  | -- | User-defined functions
    User
  | -- | Defined name
    DefinedName
  deriving (Int -> FunctionType -> ShowS
[FunctionType] -> ShowS
FunctionType -> String
(Int -> FunctionType -> ShowS)
-> (FunctionType -> String)
-> ([FunctionType] -> ShowS)
-> Show FunctionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionType -> ShowS
showsPrec :: Int -> FunctionType -> ShowS
$cshow :: FunctionType -> String
show :: FunctionType -> String
$cshowList :: [FunctionType] -> ShowS
showList :: [FunctionType] -> ShowS
Show, Int -> FunctionType
FunctionType -> Int
FunctionType -> [FunctionType]
FunctionType -> FunctionType
FunctionType -> FunctionType -> [FunctionType]
FunctionType -> FunctionType -> FunctionType -> [FunctionType]
(FunctionType -> FunctionType)
-> (FunctionType -> FunctionType)
-> (Int -> FunctionType)
-> (FunctionType -> Int)
-> (FunctionType -> [FunctionType])
-> (FunctionType -> FunctionType -> [FunctionType])
-> (FunctionType -> FunctionType -> [FunctionType])
-> (FunctionType -> FunctionType -> FunctionType -> [FunctionType])
-> Enum FunctionType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: FunctionType -> FunctionType
succ :: FunctionType -> FunctionType
$cpred :: FunctionType -> FunctionType
pred :: FunctionType -> FunctionType
$ctoEnum :: Int -> FunctionType
toEnum :: Int -> FunctionType
$cfromEnum :: FunctionType -> Int
fromEnum :: FunctionType -> Int
$cenumFrom :: FunctionType -> [FunctionType]
enumFrom :: FunctionType -> [FunctionType]
$cenumFromThen :: FunctionType -> FunctionType -> [FunctionType]
enumFromThen :: FunctionType -> FunctionType -> [FunctionType]
$cenumFromTo :: FunctionType -> FunctionType -> [FunctionType]
enumFromTo :: FunctionType -> FunctionType -> [FunctionType]
$cenumFromThenTo :: FunctionType -> FunctionType -> FunctionType -> [FunctionType]
enumFromThenTo :: FunctionType -> FunctionType -> FunctionType -> [FunctionType]
Enum)

data FunctionParameter = FunctionParameter
  { FunctionParameter -> Text
parameter'name :: Text
  , FunctionParameter -> Text
parameter'detail :: Text
  , FunctionParameter -> Text
parameter'example :: Text
  }
  deriving (Int -> FunctionParameter -> ShowS
[FunctionParameter] -> ShowS
FunctionParameter -> String
(Int -> FunctionParameter -> ShowS)
-> (FunctionParameter -> String)
-> ([FunctionParameter] -> ShowS)
-> Show FunctionParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionParameter -> ShowS
showsPrec :: Int -> FunctionParameter -> ShowS
$cshow :: FunctionParameter -> String
show :: FunctionParameter -> String
$cshowList :: [FunctionParameter] -> ShowS
showList :: [FunctionParameter] -> ShowS
Show, (forall x. FunctionParameter -> Rep FunctionParameter x)
-> (forall x. Rep FunctionParameter x -> FunctionParameter)
-> Generic FunctionParameter
forall x. Rep FunctionParameter x -> FunctionParameter
forall x. FunctionParameter -> Rep FunctionParameter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionParameter -> Rep FunctionParameter x
from :: forall x. FunctionParameter -> Rep FunctionParameter x
$cto :: forall x. Rep FunctionParameter x -> FunctionParameter
to :: forall x. Rep FunctionParameter x -> FunctionParameter
Generic)

data FunctionDescription = FunctionDescription
  { FunctionDescription -> Text
functionDescription'name :: Text
  , FunctionDescription -> FunctionType
functionDescription'type :: FunctionType
  , FunctionDescription -> Text
functionDescription'description :: Text
  , FunctionDescription -> Text
functionDescription'abstract :: Text
  , FunctionDescription -> [FunctionParameter]
functionDescription'params :: [FunctionParameter]
  }
  deriving (Int -> FunctionDescription -> ShowS
[FunctionDescription] -> ShowS
FunctionDescription -> String
(Int -> FunctionDescription -> ShowS)
-> (FunctionDescription -> String)
-> ([FunctionDescription] -> ShowS)
-> Show FunctionDescription
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FunctionDescription -> ShowS
showsPrec :: Int -> FunctionDescription -> ShowS
$cshow :: FunctionDescription -> String
show :: FunctionDescription -> String
$cshowList :: [FunctionDescription] -> ShowS
showList :: [FunctionDescription] -> ShowS
Show, (forall x. FunctionDescription -> Rep FunctionDescription x)
-> (forall x. Rep FunctionDescription x -> FunctionDescription)
-> Generic FunctionDescription
forall x. Rep FunctionDescription x -> FunctionDescription
forall x. FunctionDescription -> Rep FunctionDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FunctionDescription -> Rep FunctionDescription x
from :: forall x. FunctionDescription -> Rep FunctionDescription x
$cto :: forall x. Rep FunctionDescription x -> FunctionDescription
to :: forall x. Rep FunctionDescription x -> FunctionDescription
Generic)

{- Cells -}

data Annotation = Annotation
  { Annotation -> Text
ann'title, Annotation -> Text
ann'message :: Text
  }
  deriving (Annotation -> Annotation -> Bool
(Annotation -> Annotation -> Bool)
-> (Annotation -> Annotation -> Bool) -> Eq Annotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Annotation -> Annotation -> Bool
== :: Annotation -> Annotation -> Bool
$c/= :: Annotation -> Annotation -> Bool
/= :: Annotation -> Annotation -> Bool
Eq, (forall x. Annotation -> Rep Annotation x)
-> (forall x. Rep Annotation x -> Annotation) -> Generic Annotation
forall x. Rep Annotation x -> Annotation
forall x. Annotation -> Rep Annotation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Annotation -> Rep Annotation x
from :: forall x. Annotation -> Rep Annotation x
$cto :: forall x. Rep Annotation x -> Annotation
to :: forall x. Rep Annotation x -> Annotation
Generic, Int -> Annotation -> ShowS
[Annotation] -> ShowS
Annotation -> String
(Int -> Annotation -> ShowS)
-> (Annotation -> String)
-> ([Annotation] -> ShowS)
-> Show Annotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Annotation -> ShowS
showsPrec :: Int -> Annotation -> ShowS
$cshow :: Annotation -> String
show :: Annotation -> String
$cshowList :: [Annotation] -> ShowS
showList :: [Annotation] -> ShowS
Show)

-- | keep errors, warnings for each cell
data CustomData = CustomData
  { CustomData -> [Annotation]
customData'errors :: [Annotation]
  , CustomData -> [Annotation]
customData'warnings :: [Annotation]
  , CustomData -> [Annotation]
customData'info :: [Annotation]
  }
  deriving ((forall x. CustomData -> Rep CustomData x)
-> (forall x. Rep CustomData x -> CustomData) -> Generic CustomData
forall x. Rep CustomData x -> CustomData
forall x. CustomData -> Rep CustomData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CustomData -> Rep CustomData x
from :: forall x. CustomData -> Rep CustomData x
$cto :: forall x. Rep CustomData x -> CustomData
to :: forall x. Rep CustomData x -> CustomData
Generic, Int -> CustomData -> ShowS
[CustomData] -> ShowS
CustomData -> String
(Int -> CustomData -> ShowS)
-> (CustomData -> String)
-> ([CustomData] -> ShowS)
-> Show CustomData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomData -> ShowS
showsPrec :: Int -> CustomData -> ShowS
$cshow :: CustomData -> String
show :: CustomData -> String
$cshowList :: [CustomData] -> ShowS
showList :: [CustomData] -> ShowS
Show)

-- instance Isn't CustomData where
--  isn't (CustomData es ws nfo) = null es && null ws && null nfo

newtype BooleanInt = BooleanInt {BooleanInt -> Bool
boolean :: Bool}

data CellStyle f = CellStyle
  { forall (f :: * -> *). CellStyle f -> f BooleanInt
cellStyle'bl :: f BooleanInt
  -- ^ bold
  , forall (f :: * -> *). CellStyle f -> f BooleanInt
cellStyle'it :: f BooleanInt
  -- ^ italic
  }
  deriving ((forall x. CellStyle f -> Rep (CellStyle f) x)
-> (forall x. Rep (CellStyle f) x -> CellStyle f)
-> Generic (CellStyle f)
forall x. Rep (CellStyle f) x -> CellStyle f
forall x. CellStyle f -> Rep (CellStyle f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (CellStyle f) x -> CellStyle f
forall (f :: * -> *) x. CellStyle f -> Rep (CellStyle f) x
$cfrom :: forall (f :: * -> *) x. CellStyle f -> Rep (CellStyle f) x
from :: forall x. CellStyle f -> Rep (CellStyle f) x
$cto :: forall (f :: * -> *) x. Rep (CellStyle f) x -> CellStyle f
to :: forall x. Rep (CellStyle f) x -> CellStyle f
Generic)

-- | corresponds to ICellData
-- (see: https://univer.ai/typedoc/@univerjs/core/interfaces/ICellData)
data CellData = CellData
  { CellData -> Nullable (CellStyle Maybe)
cellData's :: Nullable (CellStyle Maybe)
  -- ^ Cell style id or style object
  , CellData -> Nullable Text
cellData'v :: Nullable Text
  -- ^ Cell original value
  , CellData -> Nullable Text
cellData'f :: Nullable Text
  -- ^ Formula
  , CellData -> Nullable Text
cellData'si :: Nullable Text
  -- ^ Formula id
  , CellData -> Nullable Text
cellData'p :: Nullable Text
  -- ^ Rich text, also a Univer Doc
  , CellData -> Nullable CustomData
cellData'custom :: Nullable CustomData
  -- ^ Custom field
  }
  deriving ((forall x. CellData -> Rep CellData x)
-> (forall x. Rep CellData x -> CellData) -> Generic CellData
forall x. Rep CellData x -> CellData
forall x. CellData -> Rep CellData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CellData -> Rep CellData x
from :: forall x. CellData -> Rep CellData x
$cto :: forall x. Rep CellData x -> CellData
to :: forall x. Rep CellData x -> CellData
Generic)

instance Show CellData where
  show :: CellData -> String
show = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String)
-> (CellData -> ByteString) -> CellData -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CellData -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encode

-- instance Isn't CellData where
--  isn't CellData{..} =
--    and
--      [ isn't cellData's
--      , isn't cellData'v
--      , isn't cellData'f
--      , isn't cellData'si
--      , isn't cellData'p
--      , isn't cellData'custom
--      ]

-- instance Meta CellData where
--  CellData s v f si p custom `merge` CellData s' v' f' si' p' custom' =
--    CellData
--      (s `merge` s')
--      (v `merge` v')
--      (f `merge` f')
--      (si `merge` si')
--      (p `merge` p')
--      (custom `merge` custom')

newtype Cells = Cells (Map (Int, Int) CellData)
  deriving (Int -> Cells -> ShowS
[Cells] -> ShowS
Cells -> String
(Int -> Cells -> ShowS)
-> (Cells -> String) -> ([Cells] -> ShowS) -> Show Cells
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cells -> ShowS
showsPrec :: Int -> Cells -> ShowS
$cshow :: Cells -> String
show :: Cells -> String
$cshowList :: [Cells] -> ShowS
showList :: [Cells] -> ShowS
Show)

{- JSON -}

{-- Params --}

instance Json.FromJSON OpenParams where
  parseJSON :: Value -> Parser OpenParams
parseJSON = Options -> Value -> Parser OpenParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.FromJSON SaveParams where
  parseJSON :: Value -> Parser SaveParams
parseJSON = Options -> Value -> Parser SaveParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.FromJSON CloseParams where
  parseJSON :: Value -> Parser CloseParams
parseJSON = Options -> Value -> Parser CloseParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.FromJSON SetRangeValuesParams where
  parseJSON :: Value -> Parser SetRangeValuesParams
parseJSON = Options -> Value -> Parser SetRangeValuesParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.FromJSON InsertSheetParams where
  parseJSON :: Value -> Parser InsertSheetParams
parseJSON = Options -> Value -> Parser InsertSheetParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.FromJSON RemoveSheetParams where
  parseJSON :: Value -> Parser RemoveSheetParams
parseJSON = Options -> Value -> Parser RemoveSheetParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.FromJSON SetWorksheetNameParams where
  parseJSON :: Value -> Parser SetWorksheetNameParams
parseJSON = Options -> Value -> Parser SetWorksheetNameParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.FromJSON DefineFunctionParams where
  parseJSON :: Value -> Parser DefineFunctionParams
parseJSON = Options -> Value -> Parser DefineFunctionParams
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.ToJSON FunctionType where
  toJSON :: FunctionType -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
Json.toJSON (Int -> Value) -> (FunctionType -> Int) -> FunctionType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionType -> Int
forall a. Enum a => a -> Int
fromEnum

instance Json.ToJSON FunctionParameter where
  toJSON :: FunctionParameter -> Value
toJSON = Options -> FunctionParameter -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON Options
aesonOptions

instance Json.ToJSON FunctionDescription where
  toJSON :: FunctionDescription -> Value
toJSON = Options -> FunctionDescription -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON Options
aesonOptions

{-- Cells --}

instance Json.FromJSON BooleanInt where
  parseJSON :: Value -> Parser BooleanInt
parseJSON Value
v = Bool -> BooleanInt
BooleanInt (Bool -> BooleanInt) -> (Int -> Bool) -> Int -> BooleanInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0 /=) (Int -> BooleanInt) -> Parser Int -> Parser BooleanInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
Json.parseJSON @Int Value
v

instance Json.ToJSON BooleanInt where
  toJSON :: BooleanInt -> Value
toJSON (BooleanInt Bool
b) = forall a. ToJSON a => a -> Value
Json.toJSON @Int (if Bool
b then Int
1 else Int
0)

instance Json.FromJSON Annotation where
  parseJSON :: Value -> Parser Annotation
parseJSON = Options -> Value -> Parser Annotation
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.ToJSON Annotation where
  toJSON :: Annotation -> Value
toJSON = Options -> Annotation -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON Options
aesonOptions

instance Json.FromJSON CustomData where
  parseJSON :: Value -> Parser CustomData
parseJSON = Options -> Value -> Parser CustomData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.ToJSON CustomData where
  toJSON :: CustomData -> Value
toJSON = Options -> CustomData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON Options
aesonOptions

instance Json.FromJSON (CellStyle Maybe) where
  parseJSON :: Value -> Parser (CellStyle Maybe)
parseJSON = Options -> Value -> Parser (CellStyle Maybe)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.ToJSON (CellStyle Maybe) where
  toJSON :: CellStyle Maybe -> Value
toJSON = Options -> CellStyle Maybe -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON Options
aesonOptions

instance Json.FromJSON CellData where
  parseJSON :: Value -> Parser CellData
parseJSON = Options -> Value -> Parser CellData
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON Options
aesonOptions

instance Json.ToJSON CellData where
  toJSON :: CellData -> Value
toJSON = Options -> CellData -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON Options
aesonOptions

--

instance Json.ToJSON Cells where
  toJSON :: Cells -> Value
toJSON (Cells Map (Int, Int) CellData
cells) =
    Map Int (Map Int CellData) -> Value
forall a. ToJSON a => a -> Value
Json.toJSON
      (Map Int (Map Int CellData) -> Value)
-> ([((Int, Int), CellData)] -> Map Int (Map Int CellData))
-> [((Int, Int), CellData)]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, Map Int CellData)] -> Map Int (Map Int CellData)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      ([(Int, Map Int CellData)] -> Map Int (Map Int CellData))
-> ([((Int, Int), CellData)] -> [(Int, Map Int CellData)])
-> [((Int, Int), CellData)]
-> Map Int (Map Int CellData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [(Int, Map Int CellData)]) -> (Int, Map Int CellData))
-> [(Int, [(Int, Map Int CellData)])] -> [(Int, Map Int CellData)]
forall a b. (a -> b) -> [a] -> [b]
map (([(Int, Map Int CellData)] -> Map Int CellData)
-> (Int, [(Int, Map Int CellData)]) -> (Int, Map Int CellData)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((Int, Map Int CellData) -> Map Int CellData)
-> [(Int, Map Int CellData)] -> Map Int CellData
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int, Map Int CellData) -> Map Int CellData
forall a b. (a, b) -> b
snd))
      ([(Int, [(Int, Map Int CellData)])] -> [(Int, Map Int CellData)])
-> ([((Int, Int), CellData)] -> [(Int, [(Int, Map Int CellData)])])
-> [((Int, Int), CellData)]
-> [(Int, Map Int CellData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Map Int CellData) -> Int)
-> [(Int, Map Int CellData)] -> [(Int, [(Int, Map Int CellData)])]
forall q a. Eq q => (a -> q) -> [a] -> [(q, [a])]
quotientOn (Int, Map Int CellData) -> Int
forall a b. (a, b) -> a
fst
      ([(Int, Map Int CellData)] -> [(Int, [(Int, Map Int CellData)])])
-> ([((Int, Int), CellData)] -> [(Int, Map Int CellData)])
-> [((Int, Int), CellData)]
-> [(Int, [(Int, Map Int CellData)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Map Int CellData) -> Int)
-> [(Int, Map Int CellData)] -> [(Int, Map Int CellData)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, Map Int CellData) -> Int
forall a b. (a, b) -> a
fst
      -- [](j,[((i,j),x)]) -> [](j,Map i x)
      ([(Int, Map Int CellData)] -> [(Int, Map Int CellData)])
-> ([((Int, Int), CellData)] -> [(Int, Map Int CellData)])
-> [((Int, Int), CellData)]
-> [(Int, Map Int CellData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [((Int, Int), CellData)]) -> (Int, Map Int CellData))
-> [(Int, [((Int, Int), CellData)])] -> [(Int, Map Int CellData)]
forall a b. (a -> b) -> [a] -> [b]
map (([((Int, Int), CellData)] -> Map Int CellData)
-> (Int, [((Int, Int), CellData)]) -> (Int, Map Int CellData)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ([(Int, CellData)] -> Map Int CellData
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, CellData)] -> Map Int CellData)
-> ([((Int, Int), CellData)] -> [(Int, CellData)])
-> [((Int, Int), CellData)]
-> Map Int CellData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int, Int), CellData) -> (Int, CellData))
-> [((Int, Int), CellData)] -> [(Int, CellData)]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, Int) -> Int) -> ((Int, Int), CellData) -> (Int, CellData)
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 (Int, Int) -> Int
row)))
      -- [((i,j),x)] -> [(j,[..])]
      ([(Int, [((Int, Int), CellData)])] -> [(Int, Map Int CellData)])
-> ([((Int, Int), CellData)] -> [(Int, [((Int, Int), CellData)])])
-> [((Int, Int), CellData)]
-> [(Int, Map Int CellData)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Int, Int), CellData) -> Int)
-> [((Int, Int), CellData)] -> [(Int, [((Int, Int), CellData)])]
forall q a. Eq q => (a -> q) -> [a] -> [(q, [a])]
quotientOn ((Int, Int) -> Int
column ((Int, Int) -> Int)
-> (((Int, Int), CellData) -> (Int, Int))
-> ((Int, Int), CellData)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), CellData) -> (Int, Int)
forall a b. (a, b) -> a
fst)
      ([((Int, Int), CellData)] -> Value)
-> [((Int, Int), CellData)] -> Value
forall a b. (a -> b) -> a -> b
$ Map (Int, Int) CellData -> [((Int, Int), CellData)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map (Int, Int) CellData
cells

-- | assumes the input list is sorted and that the @repr@ function respects the order
quotientOn :: Eq q => (a -> q) -> [a] -> [(q, [a])]
quotientOn :: forall q a. Eq q => (a -> q) -> [a] -> [(q, [a])]
quotientOn a -> q
repr = ([a] -> (q, [a])) -> [[a]] -> [(q, [a])]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> (q, [a])
repack ([[a]] -> [(q, [a])]) -> ([a] -> [[a]]) -> [a] -> [(q, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (q -> q -> Bool
forall a. Eq a => a -> a -> Bool
(==) (q -> q -> Bool) -> (a -> q) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> q
repr)
 where
  repack :: [a] -> (q, [a])
repack [a]
xs = (a -> q
repr ([a] -> a
forall a. HasCallStack => [a] -> a
head [a]
xs), [a]
xs)

instance Json.FromJSON Cells where
  parseJSON :: Value -> Parser Cells
parseJSON = (Map Int (Map Int CellData) -> Cells)
-> Parser (Map Int (Map Int CellData)) -> Parser Cells
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map (Int, Int) CellData -> Cells
Cells (Map (Int, Int) CellData -> Cells)
-> (Map Int (Map Int CellData) -> Map (Int, Int) CellData)
-> Map Int (Map Int CellData)
-> Cells
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int (Map Int CellData) -> Map (Int, Int) CellData
forall {b}. Map Int (Map Int b) -> Map (Int, Int) b
flattenMap) (Parser (Map Int (Map Int CellData)) -> Parser Cells)
-> (Value -> Parser (Map Int (Map Int CellData)))
-> Value
-> Parser Cells
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (Map Int (Map Int CellData))
forall a. FromJSON a => Value -> Parser a
Json.parseJSON
   where
    flattenMap :: Map Int (Map Int b) -> Map (Int, Int) b
flattenMap = (Map (Int, Int) b -> Int -> Map Int b -> Map (Int, Int) b)
-> Map (Int, Int) b -> Map Int (Map Int b) -> Map (Int, Int) b
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Int, Int) b -> Int -> Map Int b -> Map (Int, Int) b
forall {a} {k} {b}.
(Ord a, Ord k) =>
Map (a, k) b -> a -> Map k b -> Map (a, k) b
mergeMaps Map (Int, Int) b
forall a. Monoid a => a
mempty

    mergeMaps :: Map (a, k) b -> a -> Map k b -> Map (a, k) b
mergeMaps Map (a, k) b
m a
i = (Map (a, k) b
m <>) (Map (a, k) b -> Map (a, k) b)
-> (Map k b -> Map (a, k) b) -> Map k b -> Map (a, k) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (a, k) b -> k -> b -> Map (a, k) b)
-> Map (a, k) b -> Map k b -> Map (a, k) b
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (a -> Map (a, k) b -> k -> b -> Map (a, k) b
forall {a} {b} {a}.
(Ord a, Ord b) =>
a -> Map (a, b) a -> b -> a -> Map (a, b) a
collectEntries a
i) Map (a, k) b
forall a. Monoid a => a
mempty
    collectEntries :: a -> Map (a, b) a -> b -> a -> Map (a, b) a
collectEntries a
i Map (a, b) a
m b
j a
a = (a, b) -> a -> Map (a, b) a -> Map (a, b) a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (a
i, b
j) a
a Map (a, b) a
m