From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 8 Nov 2017 23:47:26 +0100
Subject: Use a better project structure

---
 src/client/View/Header.hs | 86 -----------------------------------------------
 1 file changed, 86 deletions(-)
 delete mode 100644 src/client/View/Header.hs

(limited to 'src/client/View/Header.hs')

diff --git a/src/client/View/Header.hs b/src/client/View/Header.hs
deleted file mode 100644
index 32738f1..0000000
--- a/src/client/View/Header.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE RecursiveDo               #-}
-
-module View.Header
-  ( view
-  , HeaderIn(..)
-  , HeaderOut(..)
-  ) where
-
-import qualified Data.Map as M
-import Data.Time (NominalDiffTime)
-import Reflex.Dom (MonadWidget, Event)
-import qualified Reflex.Dom as R
-import Prelude hiding (init, error)
-
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import Common.Model (InitResult(..), Init(..), User(..))
-import qualified Common.Model.User as User
-
-import Component.Button (ButtonIn(..))
-import qualified Component.Button as Component
-import qualified Icon
-
-data HeaderIn = HeaderIn
-  { _headerIn_initResult :: InitResult
-  }
-
-data HeaderOut t = HeaderOut
-  { _headerOut_signOut :: Event t ()
-  }
-
-view :: forall t m. MonadWidget t m => HeaderIn -> m (HeaderOut t)
-view headerIn =
-  R.el "header" $ do
-
-    R.divClass "title" $
-      R.text $ Message.get Key.App_Title
-
-    signOut <- nameSignOut $ _headerIn_initResult headerIn
-
-    return $ HeaderOut
-      { _headerOut_signOut = signOut
-      }
-
-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 User.find (_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
-  rec
-    signOut <- Component.button $ ButtonIn
-      { Component._buttonIn_class = "signOut item"
-      , Component._buttonIn_content = Icon.signOut
-      , Component._buttonIn_waiting = waiting
-      }
-    let signOutClic = Component._buttonOut_clic signOut
-        waiting = R.leftmost
-          [ fmap (const True) signOutClic
-          , fmap (const False) signOutSuccess
-          ]
-    signOutSuccess <- askSignOut signOutClic >>= R.debounce (0.5 :: NominalDiffTime)
-
-  return . fmap (const ()) . R.ffilter (== True) $ signOutSuccess
-
-  where askSignOut :: forall t m. MonadWidget t m => Event t () -> m (Event t Bool)
-        askSignOut signOut =
-          fmap getResult <$> R.performRequestAsync xhrRequest
-          where xhrRequest = fmap (const $ R.postJson "/signOut" ()) signOut
-                getResult = (== 200) . R._xhrResponse_status
-- 
cgit v1.2.3