Describe examples

.ghcid

@@ -1,3 +1,3 @@
---command "stack repl --main-is monomer:exe:todo"
+--command "stack repl --main-is monomer:exe:books"
 --test ":main"
 --restart=package.yaml

README.md

@@ -2,16 +2,16 @@
 
 An easy to use, cross platform, GUI library for writing Haskell applications.
 
-It provides a framework similar to the Elm Architecture, allowing to create GUIs
-using an extensible set of widgets with pure Haskell.
+It provides a framework similar to the Elm Architecture, allowing the creation
+of GUIs using an extensible set of widgets with pure Haskell.
 
 ## Objectives
 
-- It should be easy to use.
-- It should be extensible with custom widgets.
-- It should run on Windows, Linux and macOS.
-- It should have good documentation.
-- It should have good examples.
+- Be easy to learn and use.
+- Be extensible with custom widgets.
+- Run on Windows, Linux and macOS.
+- Have good documentation.
+- Have good examples.
 
 ### These are not objectives for this project
 
@@ -22,23 +22,51 @@ using an extensible set of widgets with pure Haskell.
 - You want to write your application in Haskell.
 - You want to write a native, not web based, application.
 
+## Usage
+
+### Setup
+
+You can read how to setup the library [here](docs/tutorials/00-setup.md).
+
+### Tutorials
+
+Several introductory tutorials are available:
+
+- [01 - Basics](docs/tutorials/01-basics.md)
+- [02 - Styling](docs/tutorials/02-styling.md)
+- [03 - Life cycle](docs/tutorials/03-life-cycle.md)
+- [04 - Tasks](docs/tutorials/04-tasks.md)
+- [05 - Producers](docs/tutorials/05-producers.md)
+- [06 - Composite](docs/tutorials/06-composite.md)
+- [07 - Custom widget](docs/tutorials/07-custom-widget.md)
+- [08 - Themes](docs/tutorials/08-themes.md)
+
+### Examples
+
+Beyond the tutorials, a few _real world like_ examples are available:
+
+- [Todo](docs/examples/01-todo.md)
+- [Books](docs/examples/02-books.md)
+- [Ticker](docs/examples/03-ticker.md)
+- [Generative](docs/examples/04-generative.md)
+
+## Roadmap
+
+There is not a planned timeline for the tasks in the roadmap.
+
+- Stability and performance.
+- Add mobile support.
+- Add support for Vulkan/Metal.
+
 ## Current limitations
 
 - Multi-platform features depend (mostly) on what SDL already provides.
   - Copy/paste is only supported for text, not images.
 - Only supports left to right text editing at the moment.
 
-## Roadmap
-
-There is not a planned timeline for the tasks in the roadmap, nor a guarantee
-that they will be implemented.
-
-- Add mobile support.
-- Add support for Vulkan/Metal.
-
 ## License
 
-The library is licensed under [BSD-3 license](LICENSE).
+The library is licensed under the [BSD-3 license](LICENSE).
 
 Fonts used in examples:
 

docs/design-decisions.md

@@ -14,11 +14,12 @@ for handling this requirement:
 
 ### Make the state explicit
 
-Users take care of storing and providing the state to the library. This would be
+Users take care of storing and providing the state to the library. This is
 similar to how the model's fields are associated to widgets.
 
-The advantage is that this makes the library more functionally pure. Plus, this
-would simplify its internals.
+The advantage is that this makes the library more functionally pure. It also
+simplify the internals and improve performance, since the merge process can be
+removed.
 
 The disadvantage is that it requires more boilerplate from part of the user,
 since fields for each of the widget's state need to be added to a global state
@@ -26,13 +27,13 @@ type (or mix it with the model).
 
 ### Keep the state internal
 
-Widgets have and internal state which is saved/restored by the library.
+Widgets have an internal state that is saved/restored by the library.
 
 The main advantage is that it's simpler for the user. Only widgets that handle
-input require the user to provide them model fields, while the rest of them is
-transparent from the user's point of view.
+input require the user to provide them model fields, while their internal state
+is transparent from the user's point of view.
 
-The disadvantages are that it makes the library more complex and, in a way, less
+The disadvantages are that it makes the library more complex and less
 functionally pure than the other approach. It also makes creating custom widgets
 a bit more complex, since the merge process needs to be considered.
 
@@ -49,16 +50,16 @@ While it's true that you can create a customized version of a widget using
 functions, and it is in fact encouraged and used in the examples, in some cases
 it is not enough.
 
-Some widgets are built out of nested widgets, and do not expose style options
-for all their sub widgets. In this scenario, themes allow you to customize those
-nested widgets as needed.
+Some widgets, such as dialogs, are built out of nested widgets and do not expose
+style options for all their sub widgets. In this scenario, themes allow you to
+customize those nested widgets as needed.
 
 Themes also have the nice property of simplifying color scheme switching.
 
 ## Why is there not a margin property, considering border and padding do exist?
 
 It used to be part of the library, but caused issues and was confusing. Since
-margin is space outside the border, it can be emulated by adding a wrapper
+margin is just space outside the border, it can be emulated by adding a wrapper
 widget. For example:
 
 ```haskell

docs/examples/01-todo.md

@@ -0,0 +1,32 @@
+# Example 01 - Todo
+
+## Description
+
+This example implements a really basic Todo list. It allows adding, modifying
+and removing Todo items. The objective is showing a more complex example with
+user input, sections displayed/hidden depending on the context, and animations.
+There is not persistence of any kind.
+
+## Interesting bits
+
+Types and UI are split in separate files. This is usually the best approach for
+modularity and compilation speed.
+
+The `TodoType` and `TodoStatus` types, both basic algebraic data types, are used
+with `textDropdownS`. Helper functions use the fact that both types are Enum
+instances to generate the list of all possible values. If you need more control
+over how the text of each option is generated, you can use `textDropdown_` and
+provide a custom conversion function.
+
+A few colors are defined at the bottom of the UI file and are used to customize
+the default themes. You can toggle the commented lines in `customLightTheme` and
+`customDarkTheme` to test how a different theme would look like.
+
+The icons provided by the Remix library are used in this example to indicate the
+remove and edit actions. Since they are distributed as a .ttf file, they can be
+loaded and used in labels or buttons as any other font.
+
+The edit section is displayed/hidden with a slide animation effect. Since slide
+animation is unidirectional, two of them with different direction are nested to
+provide the desired in/out animations. Each of them is started/stopped by the
+event handler according to the current action.

docs/examples/02-books.md

@@ -0,0 +1,35 @@
+# Example 02 - Books
+
+## Description
+
+This example shows a UI for searching books. It uses an https endpoint provided
+by Internet Archive's _Open Library_, which allows querying books using any
+piece of information (title, authors, ISBN, etc).
+
+## Interesting bits
+
+The BookTypes module defines, besides all the needed types, the
+[Aeson](https://hackage.haskell.org/package/aeson) instances used to deserialize
+the JSON response returned by the API. Only a few fields are retrieved and
+displayed in the UI, but quite a few more are available.
+
+The `BooksSearch` event is used to run a Task that calls the https endpoint.
+When a successful response is received, and event with the result is sent back
+to the application. The same happens with errors, which are displayed as an
+alert dialog.
+
+The zstack widget is used to always keep the background visible while showing
+details or errors. Unless specifically requested, input is only received by the
+top layer of zstack.
+
+A `box` with the `mergeRequired` configuration option set is used to avoid
+running the merge process on the result widgets whenever the model changes (this
+happens when the user inputs text, a dialog is displayed, etc). This is an
+optimization and should only be used when a long list of items is displayed.
+
+```haskell
+booksChanged old new = old ^. books /= new ^. books
+
+box_ [mergeRequired booksChanged] $
+  vscroll (vstack (bookRow wenv <$> model ^. books)) `nodeKey` "mainScroll"
+```

docs/examples/03-ticker.md

@@ -0,0 +1,37 @@
+# Example 03 - Ticker
+
+## Description
+
+This example shows a ticker of cryptocurrencies, consuming Binance's websockets
+API.
+
+Why where cryptocurrencies used for the example? The objective was showing a
+real time streaming API and, to make the example easy to use, that API needed to
+be free and without user registration required. No other available service
+satisfied those constraints with the same amount of constantly changing data.
+
+## Interesting bits
+
+On startup a channel is created. It is used to send subscribe/unsubscribe
+requests to the thread handling the communication with the remote API.
+
+During the `TickerInit` event, a `Producer` is launched. This producer, which
+runs on a separate thread from the application as `Task` do, performs these
+steps:
+
+- Connects to the websockets API.
+- Launches a new thread for receiving ticker data. A separate thread is required
+  because the producer also needs to receive messages from the application.
+- Subscribes to the initial ticker list.
+- Waits for application messages on its initial thread.
+
+From that point on:
+
+- When a new message from the API is received, it is feed into the application
+  using the provided `sendMsg` function.
+- When a message from the application is received, it is formatted and forwarded
+  to the server.
+
+The `TickerIgnore` event is used in Tasks that process errors and don't
+currently feed information into the application. In general you will want to
+report these errors to the user, but this is useful at prototyping time.

docs/examples/04-generative.md

@@ -0,0 +1,16 @@
+# Example 04 - Generative
+
+## Description
+
+This example is a really basic attempt at generative art. The objective is
+creating custom widgets that render more complex things than stock widgets.
+
+## Interesting bits
+
+Both widgets provide customization options for size, randomness and style. The
+UI for modifying these configuration options is handled by the application, not
+the individual widgets, and serves as an example on how integrating larger,
+customizable, pieces into a single application can work.
+
+This example uses the dial widget. It provides functionality similar to slider,
+but does so with smaller size requirements.

examples/books/BookTypes.hs

@@ -40,8 +40,9 @@ instance FromJSON BookResp where
 data BooksModel = BooksModel {
   _bkmQuery :: Text,
   _bmkSearching :: Bool,
-  _bmkSelected :: Maybe Book,
-  _bkmBooks :: [Book]
+  _bkmErrorMsg :: Maybe Text,
+  _bkmBooks :: [Book],
+  _bmkSelected :: Maybe Book
 } deriving (Eq, Show)
 
 data BooksEvt
@@ -51,6 +52,7 @@ data BooksEvt
   | BooksSearchError Text
   | BooksShowDetails Book
   | BooksCloseDetails
+  | BooksCloseError
   deriving (Eq, Show)
 
 makeLensesWith abbreviatedFields 'Book

examples/books/Main.hs

@@ -4,8 +4,10 @@
 
 module Main where
 
+import Control.Exception
 import Control.Lens
 import Data.Default
+import Data.Either.Extra
 import Data.Maybe
 import Data.Text (Text)
 import TextShow
@@ -84,6 +86,9 @@ buildUI
 buildUI wenv model = widgetTree where
   sectionBgColor = wenv ^. L.theme . L.sectionColor
 
+  errorOverlay = alertMsg msg BooksCloseError where
+    msg = fromMaybe "" (model ^. errorMsg)
+
   bookOverlay = alert BooksCloseDetails content where
     content = maybe spacer bookDetail (model ^. selected)
 
@@ -112,6 +117,7 @@ buildUI wenv model = widgetTree where
         box_ [mergeRequired booksChanged] $
           vscroll (vstack (bookRow wenv <$> model ^. books)) `nodeKey` "mainScroll"
       ],
+      errorOverlay `nodeVisible` isJust (model ^. errorMsg),
       bookOverlay `nodeVisible` isJust (model ^. selected),
       searchOverlay `nodeVisible` model ^. searching
     ]
@@ -132,21 +138,38 @@ handleEvent wenv node model evt = case evt of
     Message "mainScroll" ScrollReset,
     Model $ model
       & searching .~ False
+      & errorMsg .~ Nothing
       & books .~ resp ^. docs
     ]
-  BooksSearchError msg -> []
+  BooksSearchError msg -> [
+    Model $ model
+      & searching .~ False
+      & errorMsg ?~ msg
+      & books .~ []
+    ]
   BooksShowDetails book -> [Model $ model & selected ?~ book]
   BooksCloseDetails -> [Model $ model & selected .~ Nothing]
+  BooksCloseError -> [Model $ model & errorMsg .~ Nothing]
 
 searchBooks :: Text -> IO BooksEvt
 searchBooks query = do
-  print ("Searching", query)
-  resp <- W.asJSON =<< W.get url
-  return $ case resp ^? W.responseBody . _Just of
-    Just resp -> BooksSearchResult resp
-    Nothing -> BooksSearchError "Failed"
+  putStrLn . T.unpack $ "Searching: " <> query
+  result <- catchAny (fetch url) (return . Left . T.pack . show)
+
+  case result of
+    Right resp -> return (BooksSearchResult resp)
+    Left err -> return (BooksSearchError err)
   where
-    url = "http://openlibrary.org/search.json?q=" <> T.unpack query
+    url = "https://openlibrary.org/search.json?q=" <> T.unpack query
+    checkEmpty resp
+      | null (resp ^. docs) = Nothing
+      | otherwise = Just resp
+    fetch url = do
+      resp <- W.get url
+        >>= W.asJSON
+        >>= return . preview (W.responseBody . _Just)
+
+      return $ maybeToEither "Empty response" (resp >>= checkEmpty)
 
 main :: IO ()
 main = do
@@ -160,7 +183,7 @@ main = do
       appInitEvent BooksInit
       ]
     initBook = Book "This is my book" ["Author1", "Author 2"] (Just 2000) (Just 1234)
-    initModel = BooksModel "pedro paramo" False (Just initBook) [initBook]
+    initModel = BooksModel "pedro paramo" False Nothing [initBook] (Just initBook)
 
 customLightTheme :: Theme
 customLightTheme = lightTheme
@@ -169,3 +192,7 @@ customLightTheme = lightTheme
 customDarkTheme :: Theme
 customDarkTheme = darkTheme
   & L.userColorMap . at "rowBgColor" ?~ rgbHex "#656565"
+
+-- Utility function to avoid the "Ambiguous type variable..." error
+catchAny :: IO a -> (SomeException -> IO a) -> IO a
+catchAny = catch

examples/generative/Main.hs

@@ -33,6 +33,7 @@ buildUI wenv model = widgetTree where
         dial_ (circlesCfg . itemWidth) 20 50 [dragRate 0.5],
         labelS (model ^. circlesCfg . itemWidth) `styleBasic` [textSize 14, textCenter]
       ],
+
       label "Seed",
       seedDropdown (circlesCfg . seed)
     ]
@@ -43,11 +44,14 @@ buildUI wenv model = widgetTree where
         dial_ (boxesCfg . itemWidth) 20 50 [dragRate 0.5],
         labelS (model ^. boxesCfg . itemWidth) `styleBasic` [textSize 14, textCenter]
       ],
+
       label "Seed",
       seedDropdown (boxesCfg . seed),
       separatorLine,
+
       label "Palette type",
       textDropdown (boxesCfg . paletteType) [1..4],
+
       label "Palette size",
       vstack [
         dial_ (boxesCfg . paletteSize) 1 50 [dragRate 0.5],
@@ -61,6 +65,7 @@ buildUI wenv model = widgetTree where
         spacer,
         textDropdown_ activeGen genTypes genTypeDesc [] `nodeKey` "activeType",
         spacer,
+
         labeledCheckbox "Show config:" showCfg
       ] `styleBasic` [padding 20, bgColor sectionBg],
       zstack [
@@ -70,6 +75,7 @@ buildUI wenv model = widgetTree where
             `nodeVisible` model ^. showCfg
             `styleBasic` [padding 20, width 200, bgColor sectionBg]
         ] `nodeVisible` (model ^. activeGen == CirclesGrid),
+
         hstack [
           boxesPalette (model ^. boxesCfg) `styleBasic` [padding 20],
           widgetBoxCfg
@@ -94,7 +100,7 @@ main = do
   where
     model = GenerativeModel CirclesGrid False def def
     config = [
-      appWindowTitle "Generative art",
+      appWindowTitle "Generative",
       appTheme darkTheme,
       appFontDef "Regular" "./assets/fonts/Roboto-Regular.ttf",
       appInitEvent GenerativeInit

examples/ticker/Main.hs

@@ -118,6 +118,7 @@ handleEvent env wenv node model evt = case evt of
     Task (subscribeInitial env initialList),
     setFocusOnKey wenv "newPair"
     ]
+
   TickerAddClick -> [
     Model $ model
       & symbolPairs %~ (model ^. newPair <|)
@@ -125,20 +126,27 @@ handleEvent env wenv node model evt = case evt of
     Task $ subscribe env [model ^. newPair],
     setFocusOnKey wenv "newPair"
     ]
+
   TickerRemovePairBegin pair -> [
     Message (WidgetKey pair) AnimationStart]
+
   TickerRemovePair pair -> [
       Task $ unsubscribe env [pair],
       Model $ model & tickers . at pair .~ Nothing
     ]
+
   TickerMovePair target pair -> [
       Model $ model & symbolPairs .~ moveBefore (model^.symbolPairs) target pair
     ]
+
   TickerUpdate ticker -> [
     Model $ model & tickers . at (ticker ^. symbolPair) ?~ ticker
     ]
+
   TickerError err -> [Task $ print ("Error", err) >> return TickerIgnore]
+
   TickerResponse resp -> [Task $ print ("Response", resp) >> return TickerIgnore]
+
   TickerIgnore -> []
 
 handleSubscription :: AppEnv -> [Text] -> Text -> IO TickerEvt

examples/todo/Main.hs

@@ -60,7 +60,6 @@ todoRow wenv model idx t = animRow `nodeKey` todoKey where
 
   animRow = animFadeOut_ [onFinished (TodoDelete idx t)] todoInfo
 
-
 todoEdit :: TodoWenv -> TodoModel -> TodoNode
 todoEdit wenv model = editNode where
   sectionBg = wenv ^. L.theme . L.sectionColor
@@ -152,47 +151,57 @@ handleEvent
   -> [EventResponse TodoModel TodoEvt TodoModel ()]
 handleEvent wenv node model evt = case evt of
   TodoInit -> [setFocusOnKey wenv "todoNew"]
+
   TodoNew -> [
     Event TodoShowEdit,
     Model $ model
       & action .~ TodoAdding
       & activeTodo .~ def,
     setFocusOnKey wenv "todoDesc"]
+
   TodoEdit idx td -> [
     Event TodoShowEdit,
     Model $ model
       & action .~ TodoEditing idx
       & activeTodo .~ td,
     setFocusOnKey wenv "todoDesc"]
+
   TodoAdd -> [
     Event TodoHideEdit,
     Model $ addNewTodo wenv model,
     setFocusOnKey wenv "todoNew"]
+
   TodoSave idx -> [
     Event TodoHideEdit,
     Model $ model
       & todos . ix idx .~ (model ^. activeTodo),
     setFocusOnKey wenv "todoNew"]
+
   TodoDeleteBegin idx todo -> [
     Message (WidgetKey (todoRowKey todo)) AnimationStart]
+
   TodoDelete idx todo -> [
     Model $ model
       & action .~ TodoNone
       & todos .~ remove idx (model ^. todos),
     setFocusOnKey wenv "todoNew"]
+
   TodoCancel -> [
     Event TodoHideEdit,
     Model $ model
       & activeTodo .~ def,
     setFocusOnKey wenv "todoNew"]
+
   TodoShowEdit -> [
     Message "animEditIn" AnimationStart,
     Message "animEditOut" AnimationStop
     ]
+
   TodoHideEdit -> [
     Message "animEditIn" AnimationStop,
     Message "animEditOut" AnimationStart
     ]
+
   TodoHideEditDone -> [
     Model $ model
       & action .~ TodoNone]

tasks.md

@@ -801,6 +801,8 @@
     - Can remove resize flag from Container/selectList
 
 Next
+  - Update merge tutorial, since cursor position is not a good example anymore.
+  - Adjust theme colors.
   - Remove dpr calculations from NanoVGRenderer.
     - Same with FontManager.
     - When testing Windows/Linux, check if scroll rate needs to be adjusted.