Removed most of dead code

UI/ReflexFRP/mockUsersRoles/mockClient/app/Main.hs

@@ -1,93 +1,50 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecursiveDo #-}
-
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE DataKinds     #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DataKinds, DeriveGeneric, NoImplicitPrelude, OverloadedStrings #-}
+{-# LANGUAGE RankNTypes, RecursiveDo, ScopedTypeVariables                   #-}
+{-# LANGUAGE TypeApplications, TypeOperators                                #-}
 
 {-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -fdefer-typed-holes #-}
 
 module Main where
 
 import ClassyPrelude
+import Control.Lens
 import Reflex.Dom
+import Reflex.Dom.Contrib.Router
 
 import MockAPI
-
 import Pages.Overview
 import Pages.Edit
 import Utils
 
-import Reflex.Dom.Contrib.Router
-
--- import ClassyPrelude
--- import           Data.Proxy
--- import           Reflex.Dom
--- import qualified Reflex.Dom.Contrib.Router as RR
--- import           Servant.API
--- import           Servant.Router
-import Control.Lens
--- import Control.Lens.Wrapped
-import Web.Routes.PathInfo
--- import GHC.Generics
-
--- import Data.Time.Clock
-
 main :: IO ()
 main = mainWidget $ mdo
   Just initialUrl <- stripPrefix "http://localhost:8081" <$> getUrlText'
   putStrLn $ "The initial url is: " <> initialUrl
 
-  r :: Route _ Text <- partialPathRoute "" $ def { _routeConfig_pushState = transl <$> renderAndSwitch }
+  r :: Route _ Text <- partialPathRoute "" $ def { _routeConfig_pushState = appStateToText <$> renderAndSwitch }
   let routeValue = traceDyn "routeValue: " $ uniqDyn $ value r
 
   renderAndSwitch <- domMorph app currentState
 
   currentState    <- traceDyn "pagui "<$> (holdDyn (BootApp initialUrl) $ leftmost
     [ renderAndSwitch
-    , fmapMaybe viewSwitcher $ updated routeValue
+    , fmapMaybe textToAppState $ updated routeValue
     ])
 
   return ()
 
-transl :: AppState -> Text
-transl (BootApp _)       = "/bootApp"
-transl (Overview _ _)    = "/overview"
-transl (Edit _ _ (rn,_)) = "/edit/" <> rn
-transl _                 = "Not yet defined in transl"
-
-viewSwitcher :: Either Text Text -> Maybe AppState
-viewSwitcher (Right "/overview") = Just (BootApp "/overview")
-viewSwitcher (Right "/edit/AccountAdministrator") = Just (BootApp "/edit/AccountAdministrator")
-viewSwitcher _ = Nothing
-
-run :: forall t m . MonadWidget t m => m ()
-run = mdo
-  pb <- getPostBuild
-  text "2"
-  r :: Route t MyType <- webRoute "" $ def { _routeConfig_pushState = fmapMaybe id $ tag (current vs) go }
-  xs <- textInput def { _textInputConfig_setValue = (pack . show) <$>
-                         fmapMaybe hush (leftmost [updated (value r), tag (current $ value r) pb]) }
-  let vs :: Dynamic t (Maybe MyType) = traceDyn "vs" $ (readMay . unpack) <$> value xs
-  go <- button "Go"
-  return ()
-
--- main :: IO ()
--- main = mainWidget $ do
---   rec rendererAndSwitch <- domMorph app currentState
---       currentState      <- holdDyn BootApp rendererAndSwitch
---   return ()
+appStateToText :: AppState -> Text
+appStateToText (BootApp _)       = "/bootApp"
+appStateToText (Overview _ _)    = "/overview"
+appStateToText (Edit _ _ (rn,_)) = "/edit/" <> rn
+appStateToText _                 = "Not yet defined in appStateToText"
 
--- internalRouting :: Text -> AppState
--- internalRouting "http://localhost:8081/overwiew" = BootApp
--- internalRouting "http://localhost:8081/edit/" = Dispatcher "http://localhost:8081/overwiew"
--- internalRouting other = traceShow other NotFound
+textToAppState :: Either Text Text -> Maybe AppState
+textToAppState (Right "/overview") = Just (BootApp "/overview")
+textToAppState (Right "/edit/AccountAdministrator") = Just (BootApp "/edit/AccountAdministrator")
+textToAppState _ = Nothing
 
 app :: MonadWidget t m => AppState -> m (Event t AppState)
 app (BootApp "/overview") = do
@@ -118,97 +75,9 @@ app NotFound = do
   text "I'm really sorry, there is nothing here!"
   return never
 
--- app (Dispatcher t)
---   | t == "http://localhost:8081/overwiew" = do
---       pb <- getPostBuild
---       text "This is the dispatcher: you entered "
---       text t
---       return $ (const BootApp) <$> pb
---   | "http://localhost:8081/edit/" `isPrefixOf` t = do
-
--- ----------------------------------------------
--- -- | delay an Event by the amount of time specified in its value
--- drivenDelay     :: MonadWidget t m
---                 => Event t (NominalDiffTime,a) -- ^ delay time in seconds + value
---                 -> m (Event t a)
--- drivenDelay e =  performEventAsync . ffor e $ \(dt,a) cb -> liftIO . void . forkIO $ do
---   threadDelay . ceiling $ dt * 1000000
---   cb a
-
-
--- main :: IO ()
--- main = routeSite $ \uri -> do
---   let handler = overviewPage :<|> editPage'
---   result <- runRoute uri (Proxy @Navigation) handler
---   case result of
---     Left _ -> do
---       el "div" $ text "Incorrect address"
---       return never
---     Right e -> do
---       let e' = traceEvent "sono in main: " e
---       performEvent_ $ ffor e $ \t -> liftIO (setWindowLocationHref t)
---       return e'
-
-
--- New routing example
-
--- main :: IO ()
--- main = mainWidget run
-
--- Greg's example on webroutes
-data MyType = Cat
-            | Dog Int
-  deriving (Eq, Show, Read,Generic)
-
-instance PathInfo MyType
-
--- run :: forall t m . MonadWidget t m => m ()
--- run = mdo
---   pb <- getPostBuild
---   text "2"
---   r :: Route t MyType <- webRoute "" $ def { _routeConfig_pushState = fmapMaybe id $ tag (current vs) go }
---   xs <- textInput def { _textInputConfig_setValue = (pack . show) <$>
---                          fmapMaybe hush (leftmost [updated (value r), tag (current $ value r) pb]) }
---   let vs :: Dynamic t (Maybe MyType) = traceDyn "vs" $ (readMay . unpack) <$> value xs
---   go <- button "Go"
---   return ()
-
-hush :: Either e a -> Maybe a
-hush (Right a) = Just a
-hush _         = Nothing
-
-translateCat :: Maybe MyType -> Maybe Text
-translateCat Nothing = Nothing
-translateCat (Just Cat) = Just "cat"
-translateCat (Just (Dog n)) = Just $ "dog" <> tshow n
-
--- Master translation of greg's example
--- run :: forall t m . MonadWidget t m => m ()
--- run = mdo
---   pb <- getPostBuild
---   text "2"
---   r :: Route t <- RR.route def { _routeConfig_pushState = translate2 <$> tag (current vs) go }
---   xs <- textInput def
---     -- { _textInputConfig_setValue = tshow <$>
---     --                      fmapMaybe translate1 (leftmost [updated (value r), tag (current $ value r) pb]) }
---   let vs :: Dynamic t (Maybe AppState) = traceDyn "vs" $ translate1 <$> value xs
---   go <- button "Go"
---   dynText $ value r
---   return ()
-
--- translate1 :: Text -> Maybe AppState
--- translate1 "http://localhost:8081/overviewInit" = Just OverviewInit
--- translate1 "http://localhost:8081/editInit"     = Just EditInit
--- translate1 _ = Just BootApp
-
--- translate2 :: Maybe AppState -> Text
--- translate2 (Just OverviewInit) = "overviewInit"
--- translate2 (Just EditInit) = "editInit"
--- translate2 Nothing = "overview"
-
--- hush :: Either e a -> Maybe a
--- hush (Right a) = Just a
--- hush _         = Nothing
+--------------------------------------------------------------------------------
+-- Wrapper around the pages:
+--------------------------------------------------------------------------------
 
 overviewPage :: forall t m. MonadWidget t m => m (Event t Text)
 overviewPage = do