UI fixes and separate cabal projects for examples

frontend/src/Frontend/Examples/BasicToDo/Main.hs

@@ -31,9 +31,10 @@ new v m = case M.maxViewWithKey m of
 ulW :: (DomBuilder t m, PostBuild t m, MonadFix m, MonadHold t m)
   => Dynamic t (MM T.Text) -> m (Dynamic t (MM (Event t Int)))
 ulW xs = elClass "ul" "list" $ listWithKey xs $ \k x -> elClass "li" "element" $ do
-  dynText x -- output the text
-  fmap (const k) <$> elClass "div" "delete" (button "x")
+  e <- fmap (const k) <$> elClass "span" "delete" (button "x")
   -- tag the event of button press with the key of the text
+  elAttr "span" ("style" =: "padding: 0.5em;") $ dynText x -- output the text
+  return e
 
 -- output an input text widget with auto clean on return and return an
 -- event firing on return containing the string before clean
@@ -67,4 +68,6 @@ listW e = do
   return ()
 
 app :: (DomBuilder t m, PostBuild t m, MonadFix m, MonadHold t m) => m ()
-app = el "div" $ inputW >>= listW
+app = el "div" $ do
+  el "h4" $ text "ToDo List"
+  inputW >>= listW

frontend/src/Frontend/Examples/DragAndDrop/Main.hs

@@ -21,33 +21,32 @@ import qualified GHCJS.DOM.GlobalEventHandlers as DOM
 import qualified GHCJS.DOM.MouseEvent      as DOM
 import qualified GHCJS.DOM.Types           as DOM (uncheckedCastTo)
 
-import           Language.Javascript.JSaddle
-import           Reflex.Dom                  hiding (mainWidget)
-import           Reflex.Dom.Core             (mainWidget)
-import           Obelisk.Generated.Static
-
-main :: IO ()
-main = run $ mainWidget app
+import Language.Javascript.JSaddle
+import Reflex.Dom.Core
 
 app
   :: ( DomBuilder t m
      , Prerender js t m
      )
   => m ()
 app = do
-  prerender_ blank $ do
-    draggable item1 "a picture"
-    draggable item2 "some code"
+  el "h3" $ text "Drag and Drop"
+  el "div" $ prerender_ blank $ draggable item1 "Haskell logo"
+  el "div" $ prerender_ blank $ draggable item2 "some text"
+  text "Drap either the above logo or the text to the below box"
   handleDragEvents
   return ()
 
+
 item1 :: DomBuilder t m => m (Element EventResult (DomBuilderSpace m) t, ())
-item1 = elAttr' "img" ("draggable" =: "true" <> "src" =: static @"obelisk.jpg") blank
+item1 = elAttr' "img" ("draggable" =: "true" <> "src" =: haskellLogoUrl) blank
+  where
+    haskellLogoUrl = "https://upload.wikimedia.org/wikipedia/commons/thumb/1/1c/Haskell-Logo.svg/180px-Haskell-Logo.svg.png"
 
 item2 :: DomBuilder t m => m (Element EventResult (DomBuilderSpace m) t, ())
 item2 = elAttr' "pre" ("draggable" =: "true"
       <> "style" =: "-moz-user-select:none;-ms-user-select:none;-webkit-user-select:none;user-select:none;")
-      $ text "main = putStrLn \"Hello world!\""
+      $ text "Draggable text"
 
 draggable
   :: ( DomBuilder t m

frontend/src/Frontend/Examples/TicTacToe/Main.hs

@@ -111,8 +111,10 @@ gameBoard
 gameBoard squares = divClass "game-board" $ do
   evs <- forM [minBound .. maxBound] $ \row -> divClass "board-row" $ do
     evs <- forM [minBound .. maxBound] $ \col -> do
-      let square = (row, col)
-      (btn1,_) <- elAttr' "button" ("class" =: "square") $
+      let
+        square = (row, col)
+        style = "height: 2em; width: 2em; position: block;"
+      (btn1,_) <- elAttr' "button" ("style" =: style) $
         dynText (getSquareText square <$> squares)
       return (square <$ domEvent Click btn1)
     return (leftmost evs)
@@ -121,7 +123,7 @@ gameBoard squares = divClass "game-board" $ do
 -- | What to display on square
 getSquareText :: (Row, Col) -> Squares -> Text
 getSquareText square squares = case squares A.! square of
-  Nothing -> "_"
+  Nothing -> "."
   (Just Player_X) -> "X"
   (Just Player_O) -> "O"
 

frontend/src/Frontend/Examples/WebSocketEcho/Main.hs

@@ -4,15 +4,11 @@
 
 module Frontend.Examples.WebSocketEcho.Main where
 
-import           Control.Monad      (join)
-import           Data.Text.Encoding (encodeUtf8, decodeUtf8)
-import           Reflex.Dom         hiding (mainWidget)
-import           Reflex.Dom.Core    (mainWidget)
+import Data.Text.Encoding (encodeUtf8, decodeUtf8)
+import Reflex.Dom
+import Control.Monad      (join)
 import Control.Monad.Fix (MonadFix)
 
-main :: IO ()
-main = run $ mainWidget app
-
 app
   :: ( DomBuilder t m
      , MonadFix m

reflex-dom-projects/generateAndTestExamples.hs

@@ -0,0 +1,44 @@
+#! /usr/bin/env nix-shell
+#! nix-shell -i runghc -p "ghc.withPackages (pkgs: [ pkgs.shelly ])"
+
+{-# LANGUAGE OverloadedStrings #-}
+-- | This script creates cabal projects from the template for individual examples
+
+import Shelly
+import Control.Monad
+import qualified Data.Text as T
+
+examples =
+  [ "BasicToDo"
+  , "DragAndDrop"
+  , "FileReader"
+  , "NasaPod"
+  , "ScreenKeyboard"
+  , "TicTacToe"
+  , "WebSocketEcho"
+  ]
+
+main :: IO ()
+main = shelly $ verbosely $ do
+  forM_ examples $ \exampleName -> do
+    -- Create the cabal project skeleton
+    let
+      genDir = fromText "generated"
+      templateDir = fromText "template"
+      targetDir = genDir </> (fromText exampleName)
+    rm_rf targetDir >> mkdir_p targetDir
+    cp_r templateDir genDir
+    mv (genDir </> templateDir </> (fromText "")) targetDir
+    mv (targetDir </> (fromText "template.cabal")) (targetDir </> (fromText exampleName <.> "cabal"))
+    files <- run "find" [(toTextIgnore targetDir), "-type", "f"]
+    forM_ (T.words files) $ \f -> do
+      let sedRegex = "s/EXAMPLENAME/" <> exampleName <> "/g"
+      run_ "sed" ["-i", "-e", sedRegex, f]
+    -- Copy the source code
+    let
+      prefixDir = (fromText "Frontend/Examples")
+      srcDir = (fromText "../frontend/src/Frontend/Examples") </> (fromText exampleName)
+    mkdir_p (targetDir </> prefixDir)
+    cp_r srcDir (targetDir </> prefixDir)
+
+    -- TODO - Test cabal build

reflex-dom-projects/generated/BasicToDo/BasicToDo.cabal

@@ -0,0 +1,37 @@
+name:                reflex-examples-BasicToDo
+version:             0.1.0.0
+synopsis:            Examples for reflex and reflex-dom
+-- description:
+homepage:            https://github.com/reflex-frp/reflex-examples
+license:             BSD3
+license-file:        LICENSE
+author:              Divam
+maintainer:          dfordivam@gmail.com
+-- copyright:
+category:            Web
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+executable reflex-examples-BasicToDo
+  main-is:             Main.hs
+  other-modules:       Frontend.Examples.BasicToDo.Main
+  -- other-extensions:
+  build-depends:       base >=4.11 && <4.12
+                       , bytestring
+                       , containers
+                       , ghcjs-dom
+                       , jsaddle
+                       , lens
+                       , modern-uri
+                       , reflex
+                       , reflex-dom
+                       , random
+                       , time
+                       , vector
+                       , unordered-containers
+                       , text
+                       , aeson
+                       , array
+                       -- , jsaddle-warp
+  default-language:    Haskell2010

reflex-dom-projects/generated/BasicToDo/Frontend/Examples/BasicToDo/Main.hs

@@ -0,0 +1,73 @@
+{-# LANGUAGE OverloadedLists       #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RecursiveDo           #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+
+module Frontend.Examples.BasicToDo.Main
+  (app)
+  where
+
+{-
+ - Stripped version of todo list: just add new todo and delete an old one
+ -}
+
+import           Control.Lens
+import qualified Data.Map     as M
+import qualified Data.Text    as T
+import           Reflex.Dom
+import           Control.Monad.Fix (MonadFix)
+
+
+type MM a = M.Map Int a
+
+-- add a new value to a map, automatically choosing an unused key
+new :: a -> MM a -> MM a
+new v m = case M.maxViewWithKey m of
+  Nothing          -> [(0,v)] -- overloadedlists
+  Just ((k, _), _) -> M.insert (succ k) v m
+
+-- output the ul of the elements of the given map and return the delete
+-- event for each key
+ulW :: (DomBuilder t m, PostBuild t m, MonadFix m, MonadHold t m)
+  => Dynamic t (MM T.Text) -> m (Dynamic t (MM (Event t Int)))
+ulW xs = elClass "ul" "list" $ listWithKey xs $ \k x -> elClass "li" "element" $ do
+  e <- fmap (const k) <$> elClass "span" "delete" (button "x")
+  -- tag the event of button press with the key of the text
+  elAttr "span" ("style" =: "padding: 0.5em;") $ dynText x -- output the text
+  return e
+
+-- output an input text widget with auto clean on return and return an
+-- event firing on return containing the string before clean
+inputW :: (DomBuilder t m, MonadFix m) => m (Event t T.Text)
+inputW = do
+  rec
+    let send = keypress Enter input
+        -- send signal firing on *return* key press
+    input <- inputElement $ def
+      & inputElementConfig_setValue .~ fmap (const "") send
+      & inputElementConfig_elementConfig . elementConfig_initialAttributes .~
+        ("placeholder" =: "Write task and press enter")
+    -- inputElement with content reset on send
+  return $ tag (current $ _inputElement_value input) send
+  -- tag the send signal with the inputText value BEFORE resetting
+
+-- circuit ulW with a MM String kept updated by new strings from the passed
+-- event and deletion of single element in the MM
+listW :: (DomBuilder t m, PostBuild t m, MonadFix m, MonadHold t m)
+  => Event t T.Text -> m ()
+listW e = do
+  rec
+    xs <- foldDyn ($) M.empty $ mergeWith (.)
+    -- live state, updated by two signals
+        [   fmap new e -- insert a new text
+        ,   switch . current $ zs  -- delete text at specific keys
+        ]
+    bs <- ulW xs -- delete signals from outputted state
+    let zs = fmap (mergeWith (.) . map (fmap M.delete) . M.elems) bs
+        -- merge delete events
+  return ()
+
+app :: (DomBuilder t m, PostBuild t m, MonadFix m, MonadHold t m) => m ()
+app = el "div" $ do
+  el "h4" $ text "ToDo List"
+  inputW >>= listW

reflex-dom-projects/generated/BasicToDo/Main.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import Frontend.Examples.BasicToDo.Main
+import Reflex.Dom
+import Data.Map (Map)
+import Data.Text (Text)
+import qualified Data.Text as T
+
+main :: IO ()
+main = mainWidgetWithHead pageHead $ do
+  article $ app
+
+-- | An @<article>@ tag that will set its title and the class of its child
+-- @<section>@ based on the current route
+article
+  :: ( DomBuilder t m
+     , PostBuild t m
+     )
+  => m () -- ^ Article content widget
+  -> m ()
+article c = el "main" $ el "article" c
+
+pageHead :: DomBuilder t m => m ()
+pageHead = do
+  el "title" $ text "Reflex FRP Examples"
+  elAttr "meta" metaDesc blank
+  elAttr "meta" metaKeywords blank
+  elAttr "meta" viewport blank
+  styleSheet $ "static/css/normalize.css"
+  styleSheet $ "static/css/fontawesome.min.css"
+  styleSheet $ "static/css/font.css"
+  styleSheet $ "static/css/style.css"
+  -- elAttr "script" ("type" =: "text/javascript" <> "src" =: static @"echarts.min.js") blank
+
+metaDesc :: Map Text Text
+metaDesc = "name" =: "description"
+        <> "content" =: "Reflex Functional Reactive Programming Examples"
+
+metaKeywords :: Map Text Text
+metaKeywords = "name" =: "keywords"
+            <> "content" =: "reflex, reflex frp, functional reactive programming, haskell, framework, reflex dom"
+
+viewport :: Map Text Text
+viewport = "name" =: "viewport"
+        <> "content" =: "width=device-width, initial-scale=1"
+
+--  styleSheet are functions to add links to html <head>
+styleSheet :: DomBuilder t m => Text -> m ()
+styleSheet myLink = elAttr "link" attrs blank
+  where attrs = "rel" =: "stylesheet"
+             <> "type" =: "text/css"
+             <> "href" =: myLink
+
+tshow :: Show a => a -> Text
+tshow = T.pack . show

reflex-dom-projects/generated/BasicToDo/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

reflex-dom-projects/generated/DragAndDrop/DragAndDrop.cabal

@@ -0,0 +1,37 @@
+name:                reflex-examples-DragAndDrop
+version:             0.1.0.0
+synopsis:            Examples for reflex and reflex-dom
+-- description:
+homepage:            https://github.com/reflex-frp/reflex-examples
+license:             BSD3
+license-file:        LICENSE
+author:              Divam
+maintainer:          dfordivam@gmail.com
+-- copyright:
+category:            Web
+build-type:          Simple
+extra-source-files:  ChangeLog.md
+cabal-version:       >=1.10
+
+executable reflex-examples-DragAndDrop
+  main-is:             Main.hs
+  other-modules:       Frontend.Examples.DragAndDrop.Main
+  -- other-extensions:
+  build-depends:       base >=4.11 && <4.12
+                       , bytestring
+                       , containers
+                       , ghcjs-dom
+                       , jsaddle
+                       , lens
+                       , modern-uri
+                       , reflex
+                       , reflex-dom
+                       , random
+                       , time
+                       , vector
+                       , unordered-containers
+                       , text
+                       , aeson
+                       , array
+                       -- , jsaddle-warp
+  default-language:    Haskell2010