module Reflex.Localize.Trans where
import Control.Monad.Reader
import Control.Monad.State.Strict
import GHC.Generics
import Language.Javascript.JSaddle.Types
import Reflex
import Reflex.ExternalRef
import Reflex.Localize.Language
import Reflex.Localize.Monad
data LocalizeEnv t = LocalizeEnv {
locEnvLangRef :: !(ExternalRef t Language)
} deriving (Generic)
newLangEnv :: (Reflex t, TriggerEvent t m, MonadIO m) => Language -> m (LocalizeEnv t)
newLangEnv initLang = fmap LocalizeEnv $ newExternalRef initLang
newtype LocalizeT t m a = LocalizeT { unLocalizeT :: ReaderT (LocalizeEnv t) m a }
deriving (Functor, Applicative, Monad, Generic, MonadFix)
deriving instance PostBuild t m => PostBuild t (LocalizeT t m)
deriving instance NotReady t m => NotReady t (LocalizeT t m)
deriving instance PerformEvent t m => PerformEvent t (LocalizeT t m)
deriving instance TriggerEvent t m => TriggerEvent t (LocalizeT t m)
deriving instance MonadHold t m => MonadHold t (LocalizeT t m)
deriving instance MonadSample t m => MonadSample t (LocalizeT t m)
deriving instance MonadIO m => MonadIO (LocalizeT t m)
#ifndef ghcjs_HOST_OS
deriving instance MonadJSM m => MonadJSM (LocalizeT t m)
#endif
deriving instance (Group q, Additive q, Query q, Eq q, MonadQuery t q m, Monad m) => MonadQuery t q (LocalizeT t m)
deriving instance (Monoid w, DynamicWriter t w m) => DynamicWriter t w (LocalizeT t m)
#if !MIN_VERSION_reflex(0,7,0)
deriving instance (Monoid w, MonadBehaviorWriter t w m) => MonadBehaviorWriter t w (RetractT t m)
#endif
deriving instance (Semigroup w, EventWriter t w m) => EventWriter t w (LocalizeT t m)
deriving instance (Requester t m) => Requester t (LocalizeT t m)
instance MonadTrans (LocalizeT t) where
lift = LocalizeT . lift
{-# INLINABLE lift #-}
instance MonadReader e m => MonadReader e (LocalizeT t m) where
ask = lift ask
{-# INLINABLE ask #-}
local f (LocalizeT ma) = LocalizeT $ do
r <- ask
lift $ local f $ runReaderT ma r
{-# INLINABLE local #-}
instance MonadState s m => MonadState s (LocalizeT t m) where
get = lift get
{-# INLINABLE get #-}
put = lift . put
{-# INLINABLE put #-}
instance Adjustable t m => Adjustable t (LocalizeT t m) where
runWithReplace a0 a' = do
r <- LocalizeT ask
lift $ runWithReplace (runLocalizeT a0 r) $ fmap (`runLocalizeT` r) a'
{-# INLINABLE runWithReplace #-}
traverseIntMapWithKeyWithAdjust f dm0 dm' = do
r <- LocalizeT ask
lift $ traverseIntMapWithKeyWithAdjust (\k v -> runLocalizeT (f k v) r) dm0 dm'
{-# INLINABLE traverseIntMapWithKeyWithAdjust #-}
traverseDMapWithKeyWithAdjust f dm0 dm' = do
r <- LocalizeT ask
lift $ traverseDMapWithKeyWithAdjust (\k v -> runLocalizeT (f k v) r) dm0 dm'
{-# INLINABLE traverseDMapWithKeyWithAdjust #-}
traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do
r <- LocalizeT ask
lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runLocalizeT (f k v) r) dm0 dm'
{-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}
runLocalizeT :: LocalizeT t m a -> LocalizeEnv t -> m a
runLocalizeT (LocalizeT ma) e = runReaderT ma e
{-# INLINEABLE runLocalizeT #-}
runLocalize :: (Reflex t, TriggerEvent t m, MonadIO m) => Language -> LocalizeT t m a -> m a
runLocalize initLang ma = do
re <- newLangEnv initLang
runLocalizeT ma re
{-# INLINABLE runLocalize #-}
instance (PerformEvent t m, MonadHold t m, Adjustable t m, MonadFix m, MonadIO (Performable m), PostBuild t m, MonadIO m)
=> MonadLocalized t (LocalizeT t m) where
setLanguage lang = do
langRef <- LocalizeT $ asks locEnvLangRef
writeExternalRef langRef lang
setLanguageE langE = do
langRef <- LocalizeT $ asks locEnvLangRef
performEvent_ $ fmap (writeExternalRef langRef) langE
getLanguage = LocalizeT $ (externalRefDynamic =<< asks locEnvLangRef)
{-# INLINE setLanguage #-}
{-# INLINE setLanguageE #-}
{-# INLINE getLanguage #-}