From 11052951b74b9ad4b6a9412ae490086235f9154b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 3 Jan 2021 13:40:40 +0100
Subject: Rewrite in Rust

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

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

diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs
deleted file mode 100644
index ff9f40a..0000000
--- a/client/src/View/Header.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-module View.Header
-  ( view
-  , In(..)
-  , Out(..)
-  ) where
-
-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)
-import           Prelude          hiding (error, init)
-import           Reflex.Dom       (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom       as R
-
-import           Common.Model     (Init (..), User (..))
-import qualified Common.Model     as CM
-import qualified Common.Msg       as Msg
-import qualified Component.Button as Button
-import qualified Component.Link   as Link
-import           Model.Route      (Route (..))
-import qualified Util.Css         as CssUtil
-import qualified Util.Reflex      as ReflexUtil
-import qualified View.Icon        as Icon
-
-data In t = In
-  { _in_init  :: Dynamic t (Maybe Init)
-  , _in_route :: Dynamic t Route
-  }
-
-data Out t = Out
-  { _out_signOut :: Event t ()
-  }
-
-view :: forall t m. MonadWidget t m => (In t) -> m (Out t)
-view input =
-  R.el "header" $ do
-
-    R.divClass "title" $
-      R.text $ Msg.get Msg.App_Title
-
-    let showLinks = Maybe.isJust <$> _in_init input
-
-    signOut <- R.el "div" $ do
-      ReflexUtil.visibleIfDyn showLinks R.blank (links $ _in_route input)
-      (R.dyn $ nameSignOut <$> _in_init input) >>= ReflexUtil.flatten
-
-    return $ Out
-      { _out_signOut = signOut
-      }
-
-links :: forall t m. MonadWidget t m => Dynamic t Route -> m ()
-links route = do
-  Link.view
-    "/"
-    (R.ffor route (attrs RootRoute))
-    (Msg.get Msg.Payment_Title)
-
-  Link.view
-    "/income"
-    (R.ffor route (attrs IncomeRoute))
-    (Msg.get Msg.Income_Title)
-
-  Link.view
-    "/category"
-    (R.ffor route (attrs CategoryRoute))
-    (Msg.get Msg.Category_Title)
-
-  Link.view
-    "/statistics"
-    (R.ffor route (attrs StatisticsRoute))
-    (Msg.get Msg.Statistics_Title)
-
-  where
-    attrs linkRoute currentRoute =
-      M.singleton "class" $
-        CssUtil.classes
-          [ ("item", True)
-          , ("current", linkRoute == currentRoute)
-          ]
-
-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
-  rec
-    signOut <- Button.view $
-      (Button.defaultIn Icon.signOut)
-        { Button._in_class = R.constDyn "signOut item"
-        , Button._in_waiting = waiting
-        }
-    let signOutClic = Button._out_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 "/api/signOut" ()) signOut
-                getResult = (== 200) . R._xhrResponse_status
-- 
cgit v1.2.3