refactor: Use halogen-store for app shared state

spago.dhall

@@ -17,6 +17,7 @@
   , "foldable-traversable"
   , "foreign"
   , "halogen"
+  , "halogen-store"
   , "halogen-vdom-string-renderer"
   , "integers"
   , "js-promise-aff"

src/Components/AppStore.purs

@@ -0,0 +1,45 @@
+module App.Components.AppStore where
+
+import FatPrelude
+import Prim hiding (Row)
+
+import App.Evaluator.Common (LocalFormulaCtx)
+import App.SyntaxTree.Common (Module, QVar, QVarOp, preludeModule)
+import App.SyntaxTree.FnDef (FnInfo, OpInfo)
+import Data.HashMap as HashMap
+import Data.Tree.Zipper (fromTree)
+
+type Store =
+  { fnsMap :: HashMap QVar FnInfo
+  , operatorsMap :: HashMap QVarOp OpInfo
+  , aliasedModulesMap :: HashMap (Module /\ Module) (Set Module)
+  , importedModulesMap :: HashMap Module (Set Module)
+  }
+
+type StoreAction = Store -> Store
+
+initialStore :: Store
+initialStore =
+  { fnsMap: HashMap.empty
+  , operatorsMap: HashMap.empty
+  , aliasedModulesMap: HashMap.empty
+  , importedModulesMap: HashMap.empty
+  }
+
+reduce :: Store -> StoreAction -> Store
+reduce store k = k store
+
+mkLocalContext :: Store -> LocalFormulaCtx
+mkLocalContext store =
+  { tableData: HashMap.empty
+  , fnsMap: store.fnsMap
+  , operatorsMap: store.operatorsMap
+  , aliasedModulesMap: store.aliasedModulesMap
+  , importedModulesMap: store.importedModulesMap
+  , localFnsMap: HashMap.empty
+  , argsMap: HashMap.empty
+  , module': preludeModule
+  , scope: zero
+  , scopeLoc: fromTree $ mkLeaf zero
+  , lambdaCount: zero
+  }

src/Components/Editor.purs

@@ -2,13 +2,18 @@ module App.Components.Editor where
 
 import FatPrelude
 
+import App.Components.AppStore (Store, StoreAction)
 import App.Components.Editor.Handler (handleAction, handleQuery)
 import App.Components.Editor.Models (EditorAction(..), EditorInput, EditorOutput, EditorQuery, EditorState)
 import App.Components.Editor.Renderer (render)
 import Halogen (Component, Slot, defaultEval, mkComponent, mkEval)
+import Halogen.Store.Monad (class MonadStore)
 
 component
-  :: forall m. MonadAff m => Component EditorQuery EditorInput EditorOutput m
+  :: forall m
+   . MonadAff m
+  => MonadStore StoreAction Store m
+  => Component EditorQuery EditorInput EditorOutput m
 component =
   mkComponent
     { initialState

src/Components/Editor/Handler.purs

@@ -3,6 +3,7 @@ module App.Components.Editor.Handler where
 import FatPrelude
 
 import App.CSS.Ids (formulaBoxId, formulaCellInputId)
+import App.Components.AppStore (Store, StoreAction)
 import App.Components.Editor.HandlerHelpers (displayFnSig, displayFnSuggestions, getEditorContent, insertEditorNewLine, performAutoComplete, performSyntaxHighlight, subscribeSelectionChange, updateEditorContent)
 import App.Components.Editor.Models (EditorAction(..), EditorOutput(..), EditorQuery(..), EditorState)
 import App.Components.Table.Formula (FormulaState(..))
@@ -11,13 +12,15 @@ import App.Utils.Event (ctrlKey, toEvent)
 import App.Utils.KeyCode (KeyCode(..), isModifierKeyCode)
 import App.Utils.Selection as Selection
 import Halogen (HalogenM, raise)
+import Halogen.Store.Monad (class MonadStore, getStore)
 import Web.Event.Event (target)
 import Web.HTML (window)
 import Web.HTML.HTMLElement (fromEventTarget, setContentEditable, toNode)
 
 handleAction
   :: forall m
    . MonadAff m
+  => MonadStore StoreAction Store m
   => EditorAction
   -> HalogenM EditorState EditorAction () EditorOutput m Unit
 
@@ -70,8 +73,10 @@ handleAction (FocusIn ev) = do
     toNode <$> (fromEventTarget =<< target (toEvent ev))
 
 handleAction SelectionChange = do
+  st <- get
+  store <- getStore
   displayFnSuggestions
-  displayFnSig =<< get
+  displayFnSig st store
 
 handleAction (Receive { formulaState }) =
   modify_ _ { formulaState = formulaState }

src/Components/Editor/HandlerHelpers.purs

@@ -3,10 +3,11 @@ module App.Components.Editor.HandlerHelpers where
 import FatPrelude
 
 import App.CSS.Ids (formulaBoxId, functionSignatureId, suggestionsDropdownId)
+import App.Components.AppStore (Store, mkLocalContext)
 import App.Components.Editor.Models (EditorAction(..), EditorState)
 import App.Editor.Formula (SuggestionTerm, extractSuggestionFn, fnSigElements, formulaElements, getFnAtIndex, getFnSig, getSuggestionsAtIndex, getWordAtIndex)
 import App.Evaluator.Common (LocalFormulaCtx)
-import App.SyntaxTree.Common (QVar, preludeModule)
+import App.SyntaxTree.Common (QVar)
 import App.SyntaxTree.FnDef (SimpleFnSig)
 import App.Utils.Common (refEquals)
 import App.Utils.Dom (emptyContents, getAncestorNodes, justSelectElementById, setInnerHTML, setStyle)
@@ -15,12 +16,11 @@ import App.Utils.Range as Range
 import App.Utils.Selection (getCaretPosition, getSelection, innerText, setCaretPosition)
 import App.Utils.Selection as Selection
 import Data.Array ((!!))
-import Data.HashMap as HashMap
 import Data.String (null, splitAt) as String
 import Data.String.CodeUnits (length) as String
-import Data.Tree.Zipper (fromTree)
-import Halogen (HalogenM, subscribe')
+import Halogen (HalogenM, subscribe)
 import Halogen.Query.Event (eventListener)
+import Halogen.Store.Monad (class MonadStore, getStore)
 import Web.Event.Event (EventType(..))
 import Web.HTML (window)
 import Web.HTML.HTMLDocument as HTMLDocument
@@ -56,15 +56,16 @@ displayFnSig
   :: forall m
    . MonadEffect m
   => EditorState
+  -> Store
   -> m Unit
-displayFnSig st = liftEffect do
+displayFnSig st store = liftEffect do
   formulaBox <- toNode <$> justSelectElementById formulaBoxId
   selection <- getSelection =<< window
   ancestors <- getAncestorNodes =<< Selection.anchorNode selection
   formulaText <- getEditorContent
   idx <- getCaretPosition selection formulaBox
   let
-    ctx = mkLocalContext st
+    ctx = mkLocalContext store
     suggestion = (st.suggestions !! unwrap st.selectedSuggestionId)
       <|> (getFnAtIndex formulaText =<< idx)
     fn = extractSuggestionFn ctx =<< suggestion
@@ -73,9 +74,10 @@ displayFnSig st = liftEffect do
   maybe emptyFnSig (uncurry setFnSig) (bisequence (fn /\ fnSig))
 
 displayFnSuggestions
-  :: forall m
+  :: forall a m
    . MonadEffect m
   => MonadState EditorState m
+  => MonadStore a Store m
   => m Unit
 displayFnSuggestions = do
   st <- get
@@ -89,7 +91,8 @@ displayFnSuggestions = do
     [ "top" /\ (show (rect.top + rect.height) <> "px")
     , "left" /\ (show rect.left <> "px")
     ]
-  suggestions <- getFnSuggestions $ mkLocalContext st
+  store <- getStore
+  suggestions <- getFnSuggestions $ mkLocalContext store
   when (suggestions /= st.suggestions)
     ( modify_ _
         { suggestions = suggestions
@@ -155,28 +158,12 @@ getEditorContent = liftEffect
   (innerText =<< justSelectElementById formulaBoxId)
 
 subscribeSelectionChange
-  :: forall slots o m
+  :: forall slots st o m
    . MonadEffect m
-  => HalogenM EditorState EditorAction slots o m Unit
+  => HalogenM st EditorAction slots o m Unit
 subscribeSelectionChange = do
   doc <- liftEffect $ Window.document =<< window
-  subscribe' \_ -> eventListener
+  void $ subscribe $ eventListener
     (EventType "selectionchange")
     (HTMLDocument.toEventTarget doc)
     (const $ Just SelectionChange)
-
--- TODO: From global store
-mkLocalContext :: EditorState -> LocalFormulaCtx
-mkLocalContext _ =
-  { tableData: HashMap.empty
-  , fnsMap: HashMap.empty
-  , operatorsMap: HashMap.empty
-  , aliasedModulesMap: HashMap.empty
-  , importedModulesMap: HashMap.empty
-  , localFnsMap: HashMap.empty
-  , argsMap: HashMap.empty
-  , module': preludeModule
-  , scope: zero
-  , scopeLoc: fromTree $ mkLeaf zero
-  , lambdaCount: zero
-  }

src/Components/MainPage.purs

@@ -3,21 +3,32 @@ module App.Components.MainPage where
 import FatPrelude
 
 import App.CSS.MainPage as MainPage
+import App.Components.AppStore (Store, StoreAction)
 import App.Components.Table as Table
 import CSSPrelude (ComponentHTML)
 import Halogen (Component, Slot, defaultEval, mkComponent, mkEval)
 import Halogen.HTML (div_, slot_)
+import Halogen.Store.Monad (class MonadStore)
 import Tecton.Halogen (styleSheet)
 
-component :: forall q m. MonadAff m => Component q Unit Unit m
+component
+  :: forall q m
+   . MonadAff m
+  => MonadStore StoreAction Store m
+  => Component q Unit Unit m
 component =
   mkComponent
     { initialState: const Nothing
     , render
     , eval: mkEval defaultEval
     }
 
-render :: forall i m. MonadAff m => i -> ComponentHTML Unit Slots m
+render
+  :: forall i m
+   . MonadAff m
+  => MonadStore StoreAction Store m
+  => i
+  -> ComponentHTML Unit Slots m
 render = const $
   div_
     [ styleSheet MainPage.css

src/Components/Table.purs

@@ -3,6 +3,7 @@ module App.Components.Table where
 import FatPrelude
 import Prim hiding (Row)
 
+import App.Components.AppStore (Store, StoreAction)
 import App.Components.Table.Cell (CellValue(..), mkColumn, mkRow)
 import App.Components.Table.Formula (FormulaState(..))
 import App.Components.Table.Handler (handleAction)
@@ -11,8 +12,13 @@ import App.Components.Table.Renderer (render)
 import App.Components.Table.Selection (MultiSelection(..), SelectionState(..))
 import Data.HashMap as HashMap
 import Halogen (Component, defaultEval, mkComponent, mkEval)
+import Halogen.Store.Monad (class MonadStore)
 
-component :: forall q m. MonadAff m => Component q Unit Unit m
+component
+  :: forall q m
+   . MonadAff m
+  => MonadStore StoreAction Store m
+  => Component q Unit Unit m
 component =
   mkComponent
     { initialState
@@ -37,10 +43,6 @@ initialState = const
   , tableDependencies: HashMap.empty
   , tableFormulas: HashMap.empty
   , formulaCache: HashMap.empty
-  , fnsMap: HashMap.empty
-  , operatorsMap: HashMap.empty
-  , aliasedModulesMap: HashMap.empty
-  , importedModulesMap: HashMap.empty
   , rows: mkRow <$> (0 .. 100)
   , multiSelection: NoSelection
   , selectionState: NotStartedSelection

src/Components/Table/Handler.purs

@@ -3,6 +3,7 @@ module App.Components.Table.Handler where
 import FatPrelude
 
 import App.CSS.Ids (formulaBoxId, inputElement, selectedCellInputId)
+import App.Components.AppStore (Store, StoreAction)
 import App.Components.Editor (EditorSlot, _editor)
 import App.Components.Editor.Models (EditorOutput, EditorQuery(..))
 import App.Components.Editor.Models as EditorOutput
@@ -18,13 +19,15 @@ import App.Utils.KeyCode (KeyCode(..))
 import Data.HashMap (insert) as HashMap
 import Data.Set as Set
 import Halogen (HalogenM, tell)
+import Halogen.Store.Monad (class MonadStore)
 import Web.HTML (window)
 import Web.HTML.Window (scroll)
 import Web.UIEvent.WheelEvent (deltaX, deltaY)
 
 handleAction
   :: forall o m r
    . MonadAff m
+  => MonadStore StoreAction Store m
   => TableAction
   -> HalogenM TableState TableAction (editor :: EditorSlot | r) o m Unit