refactor Page, documentation, Dockerfile

.dockerignore

@@ -0,0 +1,5 @@
+.git
+.stack-work
+client/node_modules
+Dockerfile
+dist-newstyle

Dockerfile

@@ -0,0 +1,46 @@
+FROM haskell:9.8.2 AS base
+WORKDIR /opt/build
+
+RUN cabal update
+# skeletest network
+RUN cabal install bytestring containers casing effectful text wai warp wai-websockets cookie string-conversions hpack
+
+
+FROM haskell:9.8.2 AS dependencies
+WORKDIR /opt/build
+COPY --from=base /root/.cache /root/.cache
+COPY --from=base /root/.local /root/.local
+COPY --from=base /root/.config /root/.config
+
+# RUN apt-get update && apt-get install -y libpcre3 libpcre3-dev libcurl4-openssl-dev cron vim rsyslog
+ADD ./package.yaml .
+ADD ./cabal.project .
+RUN hpack
+RUN cabal build --only-dependencies
+
+FROM haskell:9.8.2 AS build
+WORKDIR /opt/build
+COPY --from=dependencies /root/.cache /root/.cache
+COPY --from=dependencies /root/.local /root/.local
+COPY --from=dependencies /root/.config /root/.config
+ADD ./package.yaml .
+ADD ./cabal.project .
+ADD ./client ./client
+ADD ./test ./test
+ADD ./src ./src
+ADD ./example ./example
+ADD *.md .
+ADD LICENSE .
+RUN hpack
+RUN cd example && hpack && cabal build examples
+RUN mkdir bin
+RUN cd example && export EXEC=$(cabal list-bin examples); cp $EXEC /opt/build/bin/examples
+
+
+FROM debian:10 AS app
+WORKDIR /opt/app
+
+COPY --from=build /opt/build/bin/examples ./examples
+
+# ENV DYNAMO_LOCAL=False
+ENTRYPOINT ["/opt/app/examples"]

example/.dockerignore

@@ -0,0 +1,2 @@
+dist-newstyle
+.git

example/Docs/Intro.hs

@@ -22,11 +22,11 @@ findTopLevel definition source =
   let rest = dropWhile (not . isTopLevel definition) source
    in takeWhile (not . isBlankLine) rest
  where
-  isTopLevel def line = BS.isPrefixOf def line
+  isTopLevel = BS.isPrefixOf
   isBlankLine line = BS.null $ BS.dropSpace line
 
 
-page :: (Hyperbole :> es) => Page es '[]
+page :: (Hyperbole :> es) => Eff es (Page '[])
 page = do
   pure $ exampleLayout (Docs Route.Intro) $ do
     col (pad 20 . gap 10) $ do
@@ -43,58 +43,3 @@ page = do
   sample lns =
     pre Style.code $ do
       cs $ BS.unlines lns
-
-
-messagePage = do
-  run 3000 $ do
-    liveApp (basicDocument "Example") (page messagePage)
-
-
-main = do
-  run 3000 $ do
-    liveApp (basicDocument "Example") (page messagePage)
-
-
-
--- data Counter = Counter
---   deriving (Show, Read, ViewId)
---
---
--- instance (Reader (TVar Int) :> es, Concurrent :> es) => HyperView Counter es where
---   data Action Counter
---     = Increment
---     | Decrement
---     deriving (Show, Read, ViewAction)
---
---
---   update Increment = do
---     n <- modify (+ 1)
---     pure $ viewCount n
---   update Decrement = do
---     n <- modify (subtract 1)
---     pure $ viewCount n
---
---
--- viewCount :: Int -> View Counter ()
--- viewCount n = col (gap 10) $ do
---   row id $ do
---     el (bold . fontSize 48 . border 1 . pad (XY 20 0)) $ text $ pack $ show n
---   row (gap 10) $ do
---     button Decrement Style.btn "Decrement"
---     button Increment Style.btn "Increment"
---
---
--- modify :: (Concurrent :> es, Reader (TVar Int) :> es) => (Int -> Int) -> Eff es Int
--- modify f = do
---   var <- ask
---   atomically $ do
---     modifyTVar var f
---     readTVar var
---
---
--- getCount :: (Concurrent :> es, Reader (TVar Int) :> es) => Eff es Int
--- getCount = readTVarIO =<< ask
---
---
--- initCounter :: (Concurrent :> es) => Eff es (TVar Int)
--- initCounter = newTVarIO 0

example/Example/Concurrent.hs

@@ -10,7 +10,7 @@ import Example.View.Layout (exampleLayout)
 import Web.Hyperbole
 
 
-page :: (Hyperbole :> es, Debug :> es, IOE :> es) => Page es '[Poller]
+page :: (Hyperbole :> es, Debug :> es, IOE :> es) => Eff es (Page '[Poller])
 page = do
   pure $ exampleLayout Concurrent $ do
     col (pad 20) $ do

example/Example/Contact.hs

@@ -25,7 +25,7 @@ response uid = runReader uid $ runPage page
 page
   :: forall es
    . (Hyperbole :> es, Users :> es, Debug :> es, Reader UserId :> es)
-  => Page es '[Contact]
+  => Eff es (Page '[Contact])
 page = do
   uid <- ask
   u <- Users.find uid

example/Example/Contacts.hs

@@ -19,7 +19,7 @@ import Web.Hyperbole
 page
   :: forall es
    . (Hyperbole :> es, Users :> es, Debug :> es)
-  => Page es '[Contacts, InlineContact]
+  => Eff es (Page '[Contacts, InlineContact])
 page = do
   us <- Users.all
   pure $ exampleLayout (Route.Contacts Route.ContactsAll) $ do

example/Example/Counter.hs

@@ -12,7 +12,7 @@ import Example.View.Layout (exampleLayout)
 import Web.Hyperbole as Hyperbole
 
 
-page :: (Hyperbole :> es, Concurrent :> es, Reader (TVar Int) :> es) => Page es '[Counter]
+page :: (Hyperbole :> es, Concurrent :> es, Reader (TVar Int) :> es) => Eff es (Page '[Counter])
 page = do
   n <- getCount
   pure $ exampleLayout Route.Counter $ do

example/Example/Errors.hs

@@ -7,7 +7,7 @@ import Example.View.Layout (exampleLayout)
 import Web.Hyperbole
 
 
-page :: (Hyperbole :> es) => Page es '[Contents]
+page :: (Hyperbole :> es) => Eff es (Page '[Contents])
 page = do
   pure $ exampleLayout Route.Errors $ row (pad 20) $ do
     col (gap 10 . border 1) $ do

example/Example/Forms.hs

@@ -9,7 +9,7 @@ import Example.View.Layout (exampleLayout)
 import Web.Hyperbole
 
 
-page :: (Hyperbole :> es) => Page es '[FormView]
+page :: (Hyperbole :> es) => Eff es (Page '[FormView])
 page = do
   pure $ exampleLayout Route.Forms $ row (pad 20) $ do
     hyper FormView (formView genForm)

example/Example/LazyLoading.hs

@@ -10,7 +10,7 @@ import Example.View.Layout (exampleLayout)
 import Web.Hyperbole
 
 
-page :: (Hyperbole :> es, Debug :> es) => Page es '[Contents]
+page :: (Hyperbole :> es, Debug :> es) => Eff es (Page '[Contents])
 page = do
   pure $ exampleLayout LazyLoading $ do
     row (pad 20) $ do

example/Example/Redirects.hs

@@ -7,7 +7,7 @@ import Example.View.Layout (exampleLayout)
 import Web.Hyperbole
 
 
-page :: (Hyperbole :> es) => Page es '[Contents]
+page :: (Hyperbole :> es) => Eff es (Page '[Contents])
 page = do
   pure $ exampleLayout Route.Redirects $ row (pad 20) $ do
     hyper Contents contentsView

example/Example/Requests.hs

@@ -1,14 +1,14 @@
 module Example.Requests where
 
+import Data.String.Conversions (cs)
 import Effectful
 import Example.AppRoute qualified as Route
-import Data.String.Conversions (cs)
 import Example.View.Layout (exampleLayout)
 import Web.Hyperbole
-import Web.Hyperbole.Effect.Server (Request(..))
+import Web.Hyperbole.Effect.Server (Request (..))
 
 
-page :: (Hyperbole :> es) => Page es '[]
+page :: (Hyperbole :> es) => Eff es (Page '[])
 page = do
   r <- request
   pure $ exampleLayout Route.Requests $ do
@@ -25,4 +25,3 @@ page = do
       el_ $ do
         text "Cookies: "
         text $ cs $ show $ fmap fst r.cookies
-

example/Example/Search.hs

@@ -9,7 +9,7 @@ import Web.Hyperbole
 import Prelude hiding (even, odd)
 
 
-page :: (Hyperbole :> es) => Page es '[LiveSearch]
+page :: (Hyperbole :> es) => Eff es (Page '[LiveSearch])
 page = do
   pure $ exampleLayout Route.LiveSearch $ col (pad 20) $ do
     el bold "Filter Programming Languages"

example/Example/Sessions.hs

@@ -13,7 +13,7 @@ import Example.View.Layout (exampleLayout)
 import Web.Hyperbole
 
 
-page :: (Hyperbole :> es, Debug :> es) => Page es '[Contents]
+page :: (Hyperbole :> es, Debug :> es) => Eff es (Page '[Contents])
 page = do
   -- setSession "color" Warning
   -- setSession "msg" ("________" :: Text)

example/Example/Simple.hs

@@ -16,7 +16,7 @@ main = do
     liveApp (basicDocument "Example") (runPage simplePage)
 
 
-simplePage :: (Hyperbole :> es) => Page es '[Message]
+simplePage :: (Hyperbole :> es) => Eff es (Page '[Message])
 simplePage = do
   pure $ exampleLayout Route.Simple $ col (pad 20 . gap 10) $ do
     el bold "My Page"

example/Example/Transitions.hs

@@ -7,7 +7,7 @@ import Example.View.Layout (exampleLayout)
 import Web.Hyperbole
 
 
-page :: (Hyperbole :> es) => Page es '[Contents]
+page :: (Hyperbole :> es) => Eff es (Page '[Contents])
 page = do
   pure $ exampleLayout Transitions $ do
     col (pad 10) $ do

example/HelloWorld.hs

@@ -29,7 +29,7 @@ messageView' m = do
   button (SetMessage "Goodbye World") id "Change Message"
 
 
-messagePage' :: (Hyperbole :> es) => Page es '[Message]
+messagePage' :: (Hyperbole :> es) => Eff es (Page '[Message])
 messagePage' = do
   pure $ do
     el bold "Message Page"

example/Main.hs

@@ -98,7 +98,7 @@ app users count = do
     redirect (routeUrl Simple)
 
   -- Nested Router
-  hello :: (Hyperbole :> es, Debug :> es) => Hello -> Page es '[]
+  hello :: (Hyperbole :> es, Debug :> es) => Hello -> Eff es (Page '[])
   hello (Greet who) = do
     pure $ exampleLayout (Hello $ Greet who) $ do
       row (gap 6 . pad 10) $ do

example/cabal.project

@@ -1,4 +1,4 @@
 packages:
   .
   ../
-  ../../web-view/
+  -- ../../web-view/

example/docgen/Intro.hs

@@ -1,22 +1,45 @@
+{-# LANGUAGE UndecidableInstances #-}
+
 module Intro where
 
 import Data.Text (Text)
 import Web.Hyperbole
 
 
-main :: IO ()
 main = do
   run 3000 $ do
     liveApp (basicDocument "Example") (runPage messagePage)
 
 
-messagePage :: Page es '[]
+messagePage :: Eff es (Page '[])
 messagePage = do
   pure $ do
     el bold "Hello World"
 
 
-messageView :: Text -> View c ()
+messageView :: Text -> View Message ()
 messageView m = do
-  el_ "Message:"
-  el_ (text m)
+  el bold $ text $ "Message: " <> m
+  button (SetMessage "Goodbye") (border 1) "Say Goodbye"
+
+
+data Message = Message
+  deriving (Show, Read, ViewId)
+
+
+instance HyperView Message es where
+  data Action Message
+    = SetMessage Text
+    deriving (Show, Read, ViewAction)
+
+
+  update (SetMessage t) =
+    pure $ el_ (text t)
+
+
+messagePage' :: Eff es (Page '[Message])
+messagePage' = do
+  pure $ do
+    hyper Message $ do
+      el bold "Hello World"
+      button (SetMessage "Goodbye") (border 1) "Say Goodbye"

example/docgen/Intro2.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE UndecidableInstances #-}
+
+module Intro2 where
+
+import Data.Text (Text)
+import Web.Hyperbole
+
+
+messageView :: Text -> View Message ()
+messageView m = do
+  el bold $ text $ "Message: " <> m
+  button (SetMessage "Goodbye") (border 1) "Say Goodbye"
+
+
+messagePage :: Eff es (Page '[Message])
+messagePage = do
+  pure $ do
+    hyper Message $ messageView "Hello"
+
+
+data Message = Message
+  deriving (Show, Read, ViewId)
+
+
+instance HyperView Message es where
+  data Action Message
+    = SetMessage Text
+    deriving (Show, Read, ViewAction)
+
+
+  update (SetMessage t) =
+    pure $ messageView t