{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module MisoActionLogger
( mkActionLogger
, defaultActionLogger
, defaultGroupFormat
, defaultStateFormat
, defaultActionFormat
, ActionLoggerOptions
) where
import Data.Aeson
import Miso (Effect(..))
import Miso.String hiding (head, words)
import GHCJS.Types
import GHCJS.Marshal
import GHCJS.Marshal.Pure
import MisoActionLogger.FFI
data ActionLoggerOptions action model = ActionLoggerOptions
{ groupFormat :: action -> IO JSVal
, previousStateFormat :: model -> IO JSVal
, actionFormat :: action -> IO JSVal
, nextStateFormat :: model -> IO JSVal
}
mkActionLogger
:: (Show action, ToJSON model)
=> ActionLoggerOptions action model
-> (action -> model -> Effect action model)
-> action -> model -> Effect action model
mkActionLogger ActionLoggerOptions{..} update action oldModel = Effect newModel (logSub : subs)
where
Effect newModel subs = update action oldModel
logSub _ = do
groupVal <- groupFormat action
oldVal <- previousStateFormat oldModel
actionVal <- actionFormat action
newVal <- nextStateFormat newModel
consoleGroupCollapsed groupVal
consoleLog oldVal
consoleLog actionVal
consoleLog newVal
consoleGroupEnd
defaultActionLogger
:: (Show action, ToJSON model)
=> (action -> model -> Effect action model)
-> action -> model -> Effect action model
defaultActionLogger = mkActionLogger ActionLoggerOptions
{ groupFormat = defaultGroupFormat
, previousStateFormat = defaultStateFormat defaultPreviousStateLabel defaultPreviousStateStyle
, actionFormat = defaultActionFormat
, nextStateFormat = defaultStateFormat defaultNextStateLabel defaultNextStateStyle
}
defaultPreviousStateLabel :: MisoString
defaultPreviousStateLabel = "%cprev state %c"
defaultNextStateLabel :: MisoString
defaultNextStateLabel = "%cnext state %c"
defaultPreviousStateStyle :: MisoString
defaultPreviousStateStyle = "color: #9E9E9E; font-weight: bold;"
defaultNextStateStyle :: MisoString
defaultNextStateStyle = "color: #4CAF50; font-weight: bold;"
defaultGroupFormat :: Show action => action -> IO JSVal
defaultGroupFormat action =
toJSVal
[ "%caction %c" <> ((ms . head . words . show) action)
, "color: gray; font-weight: lighter;"
, ""
]
defaultStateFormat :: ToJSON model => MisoString -> MisoString -> model -> IO JSVal
defaultStateFormat label style model = do
modelVal <- toJSVal (toJSON model)
toJSVal
[ pToJSVal label
, pToJSVal style
, pToJSVal ("" :: MisoString)
, modelVal
]
defaultActionFormat :: Show action => action -> IO JSVal
defaultActionFormat action =
toJSVal
[ pToJSVal ("%caction %c" :: MisoString)
, pToJSVal ("color: #03A9F4; font-weight: bold;" :: MisoString)
, pToJSVal ("" :: MisoString)
, pToJSVal $ show action
]