-- |
-- Module      : Reflex.Localize.Trans
-- Copyright   : (c) 2019 ATUM SOLUTIONS AG
-- License     : MIT
-- Maintainer  : lemarwin42@gmail.com
-- Stability   : unstable
-- Portability : non-portable
--
-- Plug-in implementation for `MonadLocalized` using wrapper around `ReaderT`.
-- Internal module, implementation details can be changed at any moment.
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

#if MIN_VERSION_reflex(0,9,0)
import Data.Semigroup.Commutative (Commutative)
#endif 

data LocalizeEnv t = LocalizeEnv {
  locEnvLangRef :: !(ExternalRef t Language)
} deriving (Generic)

-- | Allocate new environment for `LocalizeT`.
newLangEnv :: (Reflex t, TriggerEvent t m, MonadIO m) => Language -> m (LocalizeEnv t)
newLangEnv initLang = fmap LocalizeEnv $ newExternalRef initLang

-- | Plug-in implementation of `MonadLocalized`.
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
#if MIN_VERSION_reflex(0,9,0)
deriving instance (Group q, Commutative q, Query q, Eq q, MonadQuery t q m, Monad m) => MonadQuery t q (LocalizeT t m)
#else 
deriving instance (Group q, Additive q, Query q, Eq q, MonadQuery t q m, Monad m) => MonadQuery t q (LocalizeT t m)
#endif
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 #-}

-- | Execute localization widget with given environment.
runLocalizeT :: LocalizeT t m a -> LocalizeEnv t -> m a
runLocalizeT (LocalizeT ma) e = runReaderT ma e
{-# INLINEABLE runLocalizeT #-}

-- | Simplified version of `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 #-}