diff options
Diffstat (limited to 'client/src/View/Header.hs')
| -rw-r--r-- | client/src/View/Header.hs | 52 | 
1 files changed, 26 insertions, 26 deletions
| diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs index 5910f52..f91c408 100644 --- a/client/src/View/Header.hs +++ b/client/src/View/Header.hs @@ -6,6 +6,7 @@ module View.Header  import           Data.Map         (Map)  import qualified Data.Map         as M +import qualified Data.Maybe       as Maybe  import           Data.Text        (Text)  import qualified Data.Text        as T  import           Data.Time        (NominalDiffTime) @@ -13,7 +14,7 @@ import           Prelude          hiding (error, init)  import           Reflex.Dom       (Dynamic, Event, MonadWidget)  import qualified Reflex.Dom       as R -import           Common.Model     (Init (..), InitResult (..), User (..)) +import           Common.Model     (Init (..), User (..))  import qualified Common.Model     as CM  import qualified Common.Msg       as Msg  import qualified Component.Button as Button @@ -24,9 +25,8 @@ import qualified Util.Reflex      as ReflexUtil  import qualified View.Icon        as Icon  data In t = In -  { _in_initResult    :: InitResult -  , _in_isInitSuccess :: Bool -  , _in_route         :: Dynamic t Route +  { _in_init  :: Dynamic t (Maybe Init) +  , _in_route :: Dynamic t Route    }  data Out t = Out @@ -40,12 +40,11 @@ view input =      R.divClass "title" $        R.text $ Msg.get Msg.App_Title +    let showLinks = Maybe.isJust <$> _in_init input +      signOut <- R.el "div" $ do -      rec -        showLinks <- R.foldDyn const (_in_isInitSuccess input) (False <$ signOut) -        ReflexUtil.visibleIfDyn showLinks R.blank (links $ _in_route input) -        signOut <- nameSignOut $ _in_initResult input -      return signOut +      ReflexUtil.visibleIfDyn showLinks R.blank (links $ _in_route input) +      (R.dyn $ nameSignOut <$> _in_init input) >>= ReflexUtil.flatten      return $ Out        { _out_signOut = signOut @@ -76,23 +75,24 @@ links route = do            , ("current", linkRoute == currentRoute)            ] -nameSignOut :: forall t m. MonadWidget t m => InitResult -> m (Event t ()) -nameSignOut initResult = case initResult of -  InitSuccess init -> do -    rec -      attr <- R.holdDyn -        (M.singleton "class" "nameSignOut") -        (fmap (const $ M.fromList [("style", "visibility: hidden"), ("class", "nameSignOut")]) signOut) - -      signOut <- R.elDynAttr "nameSignOut" attr $ do -        case CM.findUser (_init_currentUser init) (_init_users init) of -          Just user -> R.divClass "name" $ R.text (_user_name user) -          Nothing   -> R.blank -        signOutButton - -    return signOut -  _ -> -    return R.never +nameSignOut :: forall t m. MonadWidget t m => Maybe Init -> m (Event t ()) +nameSignOut init = +  case init of +    Just init -> do +      rec +        attr <- R.holdDyn +          (M.singleton "class" "nameSignOut") +          (fmap (const $ M.fromList [("style", "visibility: hidden"), ("class", "nameSignOut")]) signOut) + +        signOut <- R.elDynAttr "nameSignOut" attr $ do +          case CM.findUser (_init_currentUser init) (_init_users init) of +            Just user -> R.divClass "name" $ R.text (_user_name user) +            Nothing   -> R.blank +          signOutButton + +      return signOut +    _ -> +      return R.never  signOutButton :: forall t m. MonadWidget t m => m (Event t ())  signOutButton = do | 
