frontend/frontend.cabal

@@ -20,13 +20,9 @@ executable frontend
   -- other-modules:
   -- other-extensions:
   build-depends:       base >=4.11 && <4.12
-                     , common
-                     , generic-lens
-                     , jsaddle-warp
-                     , lens
                      , miso
+                     , jsaddle-warp
                      , mtl
-                     , servant
+                     , common
   hs-source-dirs:      src
   default-language:    Haskell2010
-  ghc-options:         -Wall

frontend/src/Main.hs

@@ -1,93 +1,41 @@
-{-# LANGUAGE DataKinds                  #-}
-{-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase                 #-}
 {-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE ScopedTypeVariables          #-}
 {-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE TypeApplications           #-}
-{-# LANGUAGE TypeOperators              #-}
-{-# LANGUAGE GADTs              #-}
 module Main where
 
-import           Control.Lens                     (over, set)
 import           Control.Monad.Trans              (liftIO)
-import           Data.Generics.Product
-import           GHC.Generics                     (Generic)
 import           Language.Javascript.JSaddle.Warp
-import           Miso                             hiding (set)
+import           Miso
 import           Miso.String
-import           Servant.API
-import           Servant.Links
-import Data.Proxy (Proxy(..))
-
-type API = Home :<|> Login :<|> Register
-type Home = View Action
-type Login = "login" :> View Action
-type Register = "register" :> View Action
 
 data Action = Add
             | Subtract
             | SayHello
-            | HandleURI URI
-            | ChangeURI URI
             | NoOp
 
-data Model = Model { counter :: Int
-                   , uri     :: URI }
-  deriving (Eq, Generic)
+newtype Model = Model Int deriving (Eq, Num, ToMisoString)
 
-updateModel :: Model -> Action -> Effect Action Model
-updateModel m = \case
-  Add -> noEff (over (field @"counter") (+1) m)
-  Subtract -> noEff (over (field @"counter") (\x -> x - 1) m)
-  SayHello -> m <# (liftIO (putStrLn "Hello world") >> pure NoOp)
-  HandleURI uri -> noEff (set (field @"uri") uri m)
-  ChangeURI uri -> m <# do
-    liftIO $ putStrLn $ "Pushing uri " <> show uri
-    pushURI uri
-    return $ HandleURI uri
-  NoOp -> noEff m
+updateModel :: Action -> Model -> Effect Action Model
+updateModel Add m      = noEff (m + 1)
+updateModel Subtract m = noEff (m - 1)
+updateModel SayHello m = m <# (liftIO (putStrLn "Hello world") >> pure NoOp)
+updateModel NoOp m     = noEff m
 
 viewModel :: Model -> View Action
-viewModel model = view
-  where
-    view = either (const the404) id $ runRoute @API Proxy handlers uri model
-    handlers = home :<|> login :<|> register
-    home _ = div_ [] [ button_  [ onClick Add ] [ text "+" ]
-              , text (ms (counter model))
-              , button_ [ onClick Subtract ] [ text "-" ]
-              , button_ [ onClick goLogin ] [ text "go login" ]
-              , button_ [ onClick goRegister ] [ text "go register" ]
-            ]
-    login _ = div_ [] []
-    register _ = div_ [] [
-        h3_ [] [text "register"]
-      , label_ [] [text "Username"], input_ [id_ "username", name_ "username"]
-      , label_ [] [text "Email"], input_ [id_ "email", name_ "email"]
-      , label_ [] [text "Password"], input_ [id_ "password", name_ "password"]
-      , label_ [] [text "Password again"], input_ [id_ "passwordAgain", name_ "passwordAgain"]
-      , button_ [] [text "Register"]
-      ]
-    the404 = div_ [] []
-
-goLogin, goHome, goRegister :: Action
-goLogin = goto @Login @API Proxy Proxy
-goHome = goto @Home @API Proxy Proxy
-goRegister = goto @Register @API Proxy Proxy
-
-goto :: (IsElem endpoint api, HasLink endpoint, MkLink endpoint Link ~ Link) => Proxy api -> Proxy endpoint -> Action
-goto a b = ChangeURI (linkURI (safeLink a b))
+viewModel x =
+  div_ [] [ button_  [ onClick Add ] [ text "+" ]
+          , text (ms x)
+          , button_ [ onClick Subtract ] [ text "-" ]
+  ]
 
 main :: IO ()
-main = run 8081 $ do
-  model <- mkModel
-  startApp App{..}
+main = run 8081 $ startApp App{..}
   where
-    mkModel = Model <$> pure 0 <*> getCurrentURI
+    model = Model 0
     initialAction = SayHello
-    update = flip updateModel
+    update = updateModel
     view = viewModel
-    subs = [ uriSub HandleURI ]
+    subs = []
     events = defaultEvents
     mountPoint = Nothing