Miso automatic localstorage model persistence with debounce

Persistence.hs

{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Miso.Persistence (
    Trigger' (..),
    PersistenceDebouncer (..),
    PersistenceHandle (..),
    findPersistedModel,
    restorePersistedModel,
    debouncedPersist,
    persistUpdatedModel,
) where

import Control.FoldDebounce (Trigger)
import Control.FoldDebounce qualified as Debounce
import GHC.Generics (Generic)
import Miso (Effect, MisoString)
import Miso qualified
import Miso.JSON qualified
import Miso.Storage qualified as Storage

{- | Example usage

> import Miso.Persistence (PersistenceDebouncer (..), PersistenceHandle (..))
> import Miso.Persistence qualified as Persist
>
> data Model = Model
>     { persistenceDebouncer :: PersistenceDebouncer Model
>     }
>     deriving (Eq, Show, Generic, Miso.JSON.FromJSON, Miso.JSON.ToJSON)
>
> component_ :: Component parent Model Action
> component_ =
>     (Miso.component initModel updateModel viewModel)
>         { Miso.mount = Just HandlePageMounted
>         }
>
> updateModel :: Action -> Effect parent Model Action
> updateModel action = do
>     let persistenceHandle =
>             PersistenceHandle
>                 { localStorageKey = "translatePageModel"
>                 , handlePersistedModelFound = HandlePersistedModelFound
>                 , defaultModel = initModel
>                 , getDebouncer = (.persistenceDebouncer)
>                 , handleDebouncerInitialized = HandlePersistenceDebouncerInitialized
>                 }
>     case action of
>         HandlePageMounted -> do
>             Persist.findPersistedModel persistenceHandle
>         HandlePersistenceDebouncerInitialized debouncer ->
>             #persistenceDebouncer .= debouncer
>         HandlePersistedModelFound maybeModel -> do
>             Persist.restorePersistedModel persistenceHandle maybeModel
>     Persist.debouncedPersist persistenceHandle
-}
data PersistenceHandle model action = PersistenceHandle
    { localStorageKey :: MisoString
    , handlePersistedModelFound :: Maybe model -> action
    , defaultModel :: model
    , getDebouncer :: model -> PersistenceDebouncer model
    , handleDebouncerInitialized :: PersistenceDebouncer model -> action
    }
    deriving (Generic)

findPersistedModel ::
    forall parent model action.
    (Miso.JSON.FromJSON model) => PersistenceHandle model action -> Effect parent model action
findPersistedModel handle = Miso.io $ do
    maybeModelStr <- Storage.getLocalStorage handle.localStorageKey
    let maybeModel = maybeModelStr >>= Miso.JSON.decode @model
    pure $ handle.handlePersistedModelFound maybeModel

restorePersistedModel :: PersistenceHandle model action -> Maybe model -> Effect parent model action
restorePersistedModel handle = \case
    Just foundModel -> Miso.put foundModel
    Nothing -> Miso.put handle.defaultModel

persistUpdatedModel :: (Miso.JSON.ToJSON model) => PersistenceHandle model action -> model -> IO ()
persistUpdatedModel handle updatedModel = do
    Storage.setLocalStorage handle.localStorageKey $
        Miso.JSON.encode updatedModel

newtype Trigger' model = Trigger' (Trigger model model)

instance Eq (Trigger' model) where
    _ == _ = True

instance Show (Trigger' model) where
    show _ = "<Trigger'>"

data PersistenceDebouncer model
    = UninitializedDebouncer
    | Debouncer (Trigger' model)
    deriving (Eq, Show, Generic)

instance Miso.JSON.FromJSON (PersistenceDebouncer model) where
    parseJSON _ = pure UninitializedDebouncer

instance Miso.JSON.ToJSON (PersistenceDebouncer model) where
    toJSON _ = "<PersistenceDebouncer>"

-- | Why is this necessary? Well, if you have Actions that run on keypress, you might find yourself writing your model to localStorage very frequently, which could cause performance issues depending on the size of your model.
debouncedPersist ::
    (Miso.JSON.ToJSON model) =>
    PersistenceHandle model action -> Effect parent model action
debouncedPersist handle = do
    updatedModel <- Miso.get
    case handle.getDebouncer updatedModel of
        UninitializedDebouncer -> do
            Miso.io $ do
                trigger <-
                    Debounce.new
                        ( Debounce.Args
                            { Debounce.cb = persistUpdatedModel handle
                            , Debounce.fold = \_olderModel newerModel -> newerModel
                            , Debounce.init = updatedModel
                            }
                        )
                        Debounce.def
                pure $ handle.handleDebouncerInitialized (Debouncer (Trigger' trigger))
        Debouncer (Trigger' trigger) ->
            Miso.io_ $ Debounce.send trigger updatedModel