diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
diff --git a/Counter.hs b/Counter.hs
new file mode 100644
--- /dev/null
+++ b/Counter.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Main where
+
+
+import           Control.Monad.IO.Class      (liftIO)
+import           Data.Text                   (pack)
+import           Prelude                     hiding (span)
+
+import           Shpadoinkle
+import           Shpadoinkle.Backend.ParDiff
+import           Shpadoinkle.Html            (br'_, button, div_, h2_, id',
+                                              onClick, span)
+import           Shpadoinkle.Html.Utils
+
+
+view :: Applicative m => Int -> Html m Int
+view count = div_
+  [ h2_ [ "Counter Example" ]
+  , "The current count is: "
+  , span [ id' "out" ] [ text (pack $ show count) ]
+  , br'_, br'_
+  , button [ onClick (count - 1) ] [ "Decrement" ]
+  , button [ onClick (count + 1) ] [ "Increment" ]
+  ]
+
+
+app :: JSM ()
+app = do
+  model <- liftIO $ newTVarIO 0
+  shpadoinkle id runParDiff 0 model view getBody
+
+
+main :: IO ()
+main = runJSorWarp 8080 app
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Shpadoinkle Examples, I think I know exactly what it means
+Copyright © 2019 Isaac Shpaira
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+1. Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+3. Neither the name of the <`3:organization`> nor the
+names of its contributors may be used to endorse or promote products
+derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY <|2|> ''AS IS'' AND ANY
+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL <|2|> BE LIABLE FOR ANY
+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,19 @@
+# Shpadoinkle Examples
+
+[![Goldwater](https://gitlab.com/fresheyeball/Shpadoinkle/badges/master/pipeline.svg)](https://gitlab.com/fresheyeball/Shpadoinkle)
+[![BSD-3](https://img.shields.io/badge/License-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause)
+[![built with nix](https://img.shields.io/badge/built%20with-nix-41439a)](https://builtwithnix.org)
+[![Hackage](https://img.shields.io/hackage/v/Shpadoinkle-examples.svg)](https://hackage.haskell.org/package/Shpadoinkle-examples)
+[![Hackage Deps](https://img.shields.io/hackage-deps/v/Shpadoinkle-examples.svg)](http://packdeps.haskellers.com/reverse/Shpadoinkle-examples)
+[![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/Shpadoinkle-examples/badge)](https://matrix.hackage.haskell.org/#/package/Shpadoinkle-examples)
+
+Work in progress developing a compelling collection of example applications using Shpadoinkle.
+This repo will be used with the Shpadoinkle tutorial when it's finished.
+
+## Complete examples
+
+- Simple counter
+- TODOMVC
+- Servant CRUD using Widgets
+
+This package also houses experimental designs, and other explorations.
diff --git a/Shpadoinkle-examples.cabal b/Shpadoinkle-examples.cabal
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle-examples.cabal
@@ -0,0 +1,175 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.32.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 1659b859dd98837a87a964e0cf7684da9755b756eacede1a890dab6740e71d01
+
+name:           Shpadoinkle-examples
+version:        0.0.0.1
+synopsis:       Example usages of Shpadoinkle
+description:    A collection of illustrative applications to show various Shpadoinkle utilities.
+category:       Web
+author:         Isaac Shapira
+maintainer:     fresheyeball@protonmail.com
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://gitlab.com/fresheyeball/Shpadoinkle.git
+
+executable counter
+  main-is: Counter.hs
+  hs-source-dirs:
+      ./.
+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities
+  ghcjs-options: -Wall -Wcompat -fno-warn-missing-home-modules -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities -dedupe
+  build-depends:
+      Shpadoinkle
+    , Shpadoinkle-backend-pardiff
+    , Shpadoinkle-html
+    , base >=4.12.0 && <4.15
+    , stm
+    , text
+  default-language: Haskell2010
+
+executable servant-crud-client
+  main-is: Client.hs
+  other-modules:
+      Types
+      Types.Prim
+      View
+  hs-source-dirs:
+      ./servant-crud
+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities
+  ghcjs-options: -Wall -Wcompat -fno-warn-missing-home-modules -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities -dedupe
+  build-depends:
+      Shpadoinkle
+    , Shpadoinkle-backend-pardiff
+    , Shpadoinkle-html
+    , Shpadoinkle-lens
+    , Shpadoinkle-router
+    , Shpadoinkle-widgets
+    , aeson
+    , base >=4.12.0 && <4.15
+    , beam-core
+    , bytestring
+    , containers
+    , exceptions
+    , lens
+    , mtl
+    , servant
+    , stm
+    , text
+    , unliftio
+  if impl(ghcjs)
+    build-depends:
+        servant-client-ghcjs
+  else
+    build-depends:
+        beam-sqlite
+      , servant-client
+      , sqlite-simple
+  default-language: Haskell2010
+
+executable servant-crud-server
+  main-is: Server.hs
+  other-modules:
+      Types.Prim
+      Types
+      View
+  hs-source-dirs:
+      ./servant-crud
+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities
+  ghcjs-options: -Wall -Wcompat -fno-warn-missing-home-modules -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities -dedupe
+  build-depends:
+      Shpadoinkle
+    , Shpadoinkle-backend-static
+    , Shpadoinkle-html
+    , Shpadoinkle-lens
+    , Shpadoinkle-router
+    , Shpadoinkle-widgets
+    , aeson
+    , base >=4.12.0 && <4.15
+    , beam-core
+    , beam-sqlite
+    , bytestring
+    , containers
+    , file-embed
+    , lens
+    , mtl
+    , optparse-applicative
+    , servant
+    , servant-server
+    , sqlite-simple
+    , stm
+    , text
+    , wai
+    , wai-app-static
+    , warp
+  if impl(ghcjs)
+    buildable: False
+  else
+    buildable: True
+  default-language: Haskell2010
+
+executable todomvc
+  main-is: TODOMVC.hs
+  other-modules:
+      TODOMVC.Types
+      TODOMVC.Update
+  hs-source-dirs:
+      ./.
+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities
+  ghcjs-options: -Wall -Wcompat -fno-warn-missing-home-modules -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities -dedupe
+  build-depends:
+      Shpadoinkle
+    , Shpadoinkle-backend-pardiff
+    , Shpadoinkle-html
+    , base >=4.12.0 && <4.15
+    , containers
+    , text
+  default-language: Haskell2010
+
+executable todomvcatomic
+  main-is: TODOMVCAtomic.hs
+  other-modules:
+      TODOMVCAtomic.Types
+      TODOMVCAtomic.Update
+  hs-source-dirs:
+      ./.
+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities
+  ghcjs-options: -Wall -Wcompat -fno-warn-missing-home-modules -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities -dedupe
+  build-depends:
+      Shpadoinkle
+    , Shpadoinkle-backend-snabbdom
+    , Shpadoinkle-html
+    , base >=4.12.0 && <4.15
+    , containers
+    , lens
+    , text
+  default-language: Haskell2010
+
+executable widgets
+  main-is: Widgets.hs
+  other-modules:
+      Paths_Shpadoinkle_examples
+  hs-source-dirs:
+      ./widgets
+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities
+  ghcjs-options: -Wall -Wcompat -fno-warn-missing-home-modules -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities -dedupe
+  build-depends:
+      Shpadoinkle
+    , Shpadoinkle-backend-pardiff
+    , Shpadoinkle-html
+    , Shpadoinkle-widgets
+    , base >=4.12.0 && <4.15
+    , stm
+    , text
+  default-language: Haskell2010
diff --git a/TODOMVC.hs b/TODOMVC.hs
new file mode 100644
--- /dev/null
+++ b/TODOMVC.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+
+module Main where
+
+
+import           Data.Text                     hiding (count, filter, length)
+import           Prelude                       hiding (div, unwords)
+import           Shpadoinkle
+import           Shpadoinkle.Backend.ParDiff
+import           Shpadoinkle.Html              hiding (main)
+import           Shpadoinkle.Html.LocalStorage
+import           Shpadoinkle.Html.Memo
+import           Shpadoinkle.Html.Utils
+
+import           TODOMVC.Types
+import           TODOMVC.Update
+
+
+default (Text)
+
+
+filterHtml :: Applicative m => Visibility -> Visibility -> Html m Visibility
+filterHtml = memo2 $ \cur item -> li_
+  [ a (href "#" : onClick item : [className ("selected", cur == item)]) [ text . pack $ show item ]
+  ]
+
+
+htmlIfTasks :: Model -> [Html m a] -> [Html m a]
+htmlIfTasks m h' = if Prelude.null (tasks m) then [] else h'
+
+
+taskView :: MonadJSM m => Model -> Task -> Html m Model
+taskView m = memo $ \(Task (Description d) c tid) ->
+  li [ id' . pack . show $ unTaskId tid
+     , className [ ("completed", c == Complete)
+                 , ("editing", Just tid == editing m) ]
+     ]
+  [ div "view"
+    [ input' [ type' "checkbox"
+             , className "toggle"
+             , onChange $ toggleCompleted m tid
+             , checked $ c == Complete
+             ]
+    , label [ onDblclick (toggleEditing m (Just tid)) ] [ text d ]
+    , button' [ className "destroy", onClick (removeTask m tid) ]
+    ]
+  , form [ onSubmit $ toggleEditing m Nothing ]
+    [ input' [ className "edit"
+             , value d
+             , onInput $ updateTaskDescription m tid . Description
+             , autofocus True
+             , onBlur $ toggleEditing m Nothing
+             ]
+    ]
+  ]
+
+
+listFooter :: Applicative m => Model -> Html m Model
+listFooter model = footer "footer" $
+  [ Shpadoinkle.Html.span "todo-count" $ let co = count Incomplete $ tasks model in
+    [ strong_ [ text . pack $ show co ]
+    , text $ " item" <> (if co == 1 then "" else "s") <> " left"
+    ]
+  , ul "filters" $ fmap (\v -> model { visibility = v })
+                <$> (filterHtml (visibility model) <$> [minBound..maxBound])
+  ] ++ (if count Complete (tasks model) == 0 then [] else
+  [ button [ className "clear-completed", onClick $ clearComplete model ] [ "Clear completed" ]
+  ])
+
+
+
+info :: Html m a
+info = footer "info"
+  [ p_ [ "Double-click to edit a todo" ]
+  , p_ [ "Credits ", a [ href "https://twitter.com/fresheyeball" ] [ "Isaac Shapira" ] ]
+  , p_ [ "Part of ", a [ href "http://todomvc.com" ] [ "TodoMVC" ] ]
+  ]
+
+
+newTaskForm :: MonadJSM m => Model -> Html m Model
+newTaskForm model = form [ className "todo-form", onSubmit (appendItem model) ]
+  [ input' [ className "new-todo"
+           , value . unDescription $ current model
+           , onInput $ updateDescription model . Description
+           , placeholder "What needs to be done?" ]
+  ]
+
+
+todoList :: MonadJSM m => Model -> Html m Model
+todoList model = ul "todo-list" $ taskView model <$> toVisible (visibility model) (tasks model)
+
+
+toggleAllBtn :: Applicative m => Model -> [Html m Model]
+toggleAllBtn model =
+  [ input' [ id' "toggle-all", className "toggle-all", type' "checkbox", onChange (toggleAll model) ]
+  , label [ for' "toggle-all" ] [ "Mark all as complete" ]
+  ]
+
+
+view :: MonadJSM m => Model -> Html m Model
+view model = div_
+  [ section "todoapp" $
+    header "header"
+      [ h1_ [ "todos" ], newTaskForm model ]
+    : htmlIfTasks model
+    [ section "main" $ toggleAllBtn model ++ [ todoList model ]
+    , listFooter model
+    ]
+  , info
+  ]
+
+
+app :: JSM ()
+app = do
+  model <- manageLocalStorage "todo" emptyModel
+  initial <- readTVarIO model
+  addStyle "https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.css"
+  addStyle "https://cdn.jsdelivr.net/npm/todomvc-app-css@2.2.0/index.css"
+  shpadoinkle id runParDiff initial model view getBody
+
+
+main :: IO ()
+main = do
+  putStrLn "running app"
+  runJSorWarp 8080 app
+
diff --git a/TODOMVC/Types.hs b/TODOMVC/Types.hs
new file mode 100644
--- /dev/null
+++ b/TODOMVC/Types.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+
+
+module TODOMVC.Types where
+
+
+import           Data.String
+import           Data.Text
+
+
+newtype Description = Description { unDescription :: Text } deriving (Show, Read, Eq, IsString)
+newtype TaskId      = TaskId      { unTaskId      :: Int  } deriving (Show, Read, Eq, Ord, Num)
+
+
+data Completed  = Complete | Incomplete
+  deriving (Show, Read, Eq)
+
+
+data Visibility = All | Active | Completed
+  deriving (Show, Read, Eq, Ord, Enum, Bounded)
+
+
+data Task = Task
+  { description :: Description
+  , completed   :: Completed
+  , taskId      :: TaskId
+  } deriving (Show, Read, Eq)
+
+
+data Model = Model
+  { tasks      :: [Task]
+  , editing    :: Maybe TaskId
+  , visibility :: Visibility
+  , current    :: Description
+  } deriving (Show, Read, Eq)
+
+
+emptyModel :: Model
+emptyModel = Model [] Nothing All (Description "")
diff --git a/TODOMVC/Update.hs b/TODOMVC/Update.hs
new file mode 100644
--- /dev/null
+++ b/TODOMVC/Update.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module TODOMVC.Update where
+
+
+import           TODOMVC.Types
+
+
+appendItem :: Model -> Model
+appendItem m = if current m /= "" then m
+  { tasks = Task (current m) Incomplete ((+ 1)
+          $ Prelude.maximum $ 0 : (taskId <$> tasks m)) : tasks m
+  , current = "" }
+  else m
+
+
+updateDescription :: Model -> Description -> Model
+updateDescription m d = m { current = d }
+
+
+toggleCompleted :: Model -> TaskId -> Model
+toggleCompleted m tid = m { tasks =
+  (\t -> if taskId t == tid then t { completed = negC (completed t) } else t) <$> tasks m }
+  where negC Complete   = Incomplete
+        negC Incomplete = Complete
+
+
+toggleEditing :: Model -> Maybe TaskId -> Model
+toggleEditing m t = m { editing = t }
+
+
+updateTaskDescription :: Model -> TaskId -> Description -> Model
+updateTaskDescription m tid desc = m { tasks = f <$> tasks m}
+  where f t = if taskId t == tid then t { description = desc } else t
+
+
+removeTask :: Model -> TaskId -> Model
+removeTask m tid = m { tasks = filter ((/= tid) . taskId) $ tasks m}
+
+
+toggleAll :: Model -> Model
+toggleAll m = m { tasks = (\t -> t { completed = c }) <$> tasks m}
+  where c = if Prelude.all ((== Complete) . completed) $ tasks m then Incomplete else Complete
+
+
+count :: Completed -> [Task] -> Int
+count c = length . filter ((== c) . completed)
+
+
+clearComplete :: Model -> Model
+clearComplete m = m { tasks = filter ((== Incomplete) . completed) (tasks m) }
+
+
+toVisible :: Visibility -> [Task] -> [Task]
+toVisible v = case v of
+  All       -> id
+  Active    -> filter $ (== Incomplete) . completed
+  Completed -> filter $ (== Complete)   . completed
diff --git a/TODOMVCAtomic.hs b/TODOMVCAtomic.hs
new file mode 100644
--- /dev/null
+++ b/TODOMVCAtomic.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+
+module Main where
+
+
+import           Control.Lens                  (set, to, (%~), (.~), (?~), (^.),
+                                                _Wrapped)
+import           Data.Text                     hiding (count, filter, length)
+import           Prelude                       hiding (div, unwords)
+import           Shpadoinkle
+import           Shpadoinkle.Backend.Snabbdom
+import           Shpadoinkle.Html              hiding (main)
+import           Shpadoinkle.Html.LocalStorage
+import           Shpadoinkle.Html.Memo
+import           Shpadoinkle.Html.Utils
+
+import           TODOMVCAtomic.Types
+import           TODOMVCAtomic.Update
+
+
+default (Text)
+
+
+filterHtml :: Applicative m => Eq v => Show v => v -> v -> Html m v
+filterHtml = memo $ \cur item -> li_
+  [ a [href "#" , onClick item , className [("selected", cur == item)]] [ text . pack $ show item ]
+  ]
+
+
+htmlIfTasks :: [b] -> [Html m a] -> [Html m a]
+htmlIfTasks m h' = if Prelude.null m then [] else h'
+
+
+taskView :: MonadJSM m => Maybe TaskId -> Task -> Html m (Model -> Model)
+taskView = memo $ \ed (Task (Description d) c tid) ->
+  li [ id' . pack . show $ tid ^. _Wrapped
+     , className [ ("completed", c == Complete)
+                 , ("editing",   Just tid == ed) ]
+     ]
+  [ div "view"
+    [ input' [ type' "checkbox"
+             , className "toggle"
+             , onChange $ toggleCompleted tid
+             , checked $ c == Complete
+             ]
+    , label [ onDblclick $ editing ?~ tid ] [ text d ]
+   , button' [ className "destroy", onClick $ tasks %~ filter ((/= tid) . _taskId) ]
+    ]
+  , form [ onSubmit $ editing .~ Nothing ]
+    [ input' [ className "edit"
+             , value d
+             , onInput $ updateTaskDescription tid . Description
+             , autofocus True
+             , onBlur $ editing .~ Nothing
+             ]
+    ]
+  ]
+
+
+listFooter :: Applicative m => Int -> Int -> Visibility -> Html m (Model -> Model)
+listFooter = memo $ \ic cc v -> footer "footer" $
+  [ Shpadoinkle.Html.span "todo-count"
+    [ strong_ [ text . pack $ show ic ]
+    , text $ " item" <> (if ic == 1 then "" else "s") <> " left"
+    ]
+  , ul "filters" $ fmap (set visibility) . filterHtml v <$> [minBound..maxBound]
+  ] ++ (if cc == 0 then [] else
+  [ button [ className "clear-completed", onClick clearComplete ] [ "Clear completed" ]
+  ])
+
+
+
+info :: Html m a
+info = footer "info"
+  [ p_ [ "Double-click to edit a todo" ]
+  , p_ [ "Credits ", a [ href "https://twitter.com/fresheyeball" ] [ "Isaac Shapira" ] ]
+  , p_ [ "Part of ", a [ href "http://todomvc.com" ] [ "TodoMVC" ] ]
+  ]
+
+
+newTaskForm :: MonadJSM m => Description -> Html m (Model -> Model)
+newTaskForm = memo $ \desc -> form [ className "todo-form", onSubmit appendItem' ]
+  [ input' [ className "new-todo"
+           , value $ desc ^. _Wrapped
+           , onInput . set $ current . _Wrapped
+           , placeholder "What needs to be done?" ]
+  ]
+
+
+todoList :: MonadJSM m => Maybe TaskId -> Visibility -> [Task] -> Html m (Model -> Model)
+todoList = memo $ \ed v ts -> ul "todo-list" $ taskView ed <$> toVisible v ts
+
+
+toggleAllBtn :: Applicative m => [Html m (Model -> Model)]
+toggleAllBtn =
+  [ input' [ id' "toggle-all", className "toggle-all", type' "checkbox", onChange toggleAll ]
+  , label [ for' "toggle-all" ] [ "Mark all as complete" ]
+  ]
+
+
+apply :: Functor m => a -> Html m (a -> b) -> Html m b
+apply m v = ($ m) <$> v
+
+
+
+render :: MonadJSM m => Model -> Html m Model
+render m = div_
+  [ section "todoapp" $
+    header "header"
+      [ h1_ [ "todos" ], apply m . newTaskForm $ m ^. current ]
+    : htmlIfTasks (m ^. tasks)
+    [ section "main" $ (apply m <$> toggleAllBtn) ++ [ apply m $ todoList (m ^. editing) (m ^. visibility) (m ^. tasks) ]
+    , apply m $ listFooter (m ^. tasks . to (count Incomplete))
+                           (m ^. tasks . to (count Complete))
+                           (m ^. visibility)
+    ]
+  , info
+  ]
+
+
+app :: JSM ()
+app = do
+  model <- manageLocalStorage "todo" emptyModel
+  addStyle "https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.css"
+  addStyle "https://cdn.jsdelivr.net/npm/todomvc-app-css@2.2.0/index.css"
+  initial <- readTVarIO model
+  shpadoinkle id runSnabbdom initial model render stage
+
+
+main :: IO ()
+main = runJSorWarp 8080 app
+
diff --git a/TODOMVCAtomic/Types.hs b/TODOMVCAtomic/Types.hs
new file mode 100644
--- /dev/null
+++ b/TODOMVCAtomic/Types.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+
+
+module TODOMVCAtomic.Types where
+
+
+import           Control.Lens.TH
+import           Data.String
+import           Data.Text
+
+
+newtype Description = Description { _unDescription :: Text } deriving (Show, Read, Eq, IsString)
+newtype TaskId      = TaskId      { _unTaskId      :: Int  } deriving (Show, Read, Eq, Ord, Num)
+
+
+makeWrapped ''Description
+makeWrapped ''TaskId
+
+
+data Completed  = Complete | Incomplete
+  deriving (Show, Read, Eq)
+
+
+makePrisms ''Completed
+
+
+data Visibility = All | Active | Completed
+  deriving (Show, Read, Eq, Ord, Enum, Bounded)
+
+
+makePrisms ''Visibility
+
+
+data Task = Task
+  { _description :: Description
+  , _completed   :: Completed
+  , _taskId      :: TaskId
+  } deriving (Show, Read, Eq)
+
+
+makeLenses ''Task
+
+
+data Model = Model
+  { _tasks      :: [Task]
+  , _editing    :: Maybe TaskId
+  , _visibility :: Visibility
+  , _current    :: Description
+  } deriving (Show, Read, Eq)
+
+
+makeLenses ''Model
+
+
+emptyModel :: Model
+emptyModel = Model [] Nothing All (Description "")
diff --git a/TODOMVCAtomic/Update.hs b/TODOMVCAtomic/Update.hs
new file mode 100644
--- /dev/null
+++ b/TODOMVCAtomic/Update.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module TODOMVCAtomic.Update where
+
+
+import           TODOMVCAtomic.Types
+
+
+appendItem' :: Model -> Model
+appendItem' m = if _current m /= "" then m
+  { _tasks = Task (_current m) Incomplete ((+ 1)
+          $ Prelude.maximum $ 0 : (_taskId <$> _tasks m)) : _tasks m
+  , _current = "" }
+  else m
+
+toggleCompleted :: TaskId -> Model -> Model
+toggleCompleted tid m = m { _tasks =
+  (\t -> if _taskId t == tid then t { _completed = negC (_completed t) } else t) <$> _tasks m }
+  where negC Complete   = Incomplete
+        negC Incomplete = Complete
+
+
+updateTaskDescription :: TaskId -> Description -> Model -> Model
+updateTaskDescription tid desc m = m { _tasks = f <$> _tasks m}
+  where f t = if _taskId t == tid then t { _description = desc } else t
+
+
+toggleAll :: Model -> Model
+toggleAll m = m { _tasks = (\t -> t { _completed = c }) <$> _tasks m}
+  where c = if Prelude.all ((== Complete) . _completed) $ _tasks m then Incomplete else Complete
+
+
+count :: Completed -> [Task] -> Int
+count c = length . filter ((== c) . _completed)
+
+
+clearComplete :: Model -> Model
+clearComplete m = m { _tasks = filter ((== Incomplete) . _completed) (_tasks m) }
+
+
+toVisible :: Visibility -> [Task] -> [Task]
+toVisible v = case v of
+  All       -> id
+  Active    -> filter $ (== Incomplete) . _completed
+  Completed -> filter $ (== Complete)   . _completed
diff --git a/servant-crud/Client.hs b/servant-crud/Client.hs
new file mode 100644
--- /dev/null
+++ b/servant-crud/Client.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+
+module Main where
+
+
+import           Control.Monad.Catch         (MonadThrow)
+import           Control.Monad.Reader        (MonadIO)
+import           Data.Proxy                  (Proxy (..))
+import           Servant.API                 ((:<|>) (..))
+import           Shpadoinkle
+import           Shpadoinkle.Backend.ParDiff (runParDiff)
+import           Shpadoinkle.Html.Utils      (getBody)
+import           Shpadoinkle.Router          (fullPageSPA, withHydration)
+import           Shpadoinkle.Router.Client   (client, runXHR)
+import           UnliftIO                    (MonadUnliftIO (..), UnliftIO (..))
+
+import           Types
+import           View
+
+
+newtype App a = App { runApp :: JSM a }
+  deriving (Functor, Applicative, Monad, MonadIO, MonadThrow)
+#ifndef ghcjs_HOST_OS
+  deriving (MonadJSM)
+#endif
+
+
+instance MonadUnliftIO App where
+  {-# INLINE askUnliftIO #-}
+  askUnliftIO = do ctx <- askJSM; return $ UnliftIO $ \(App m) -> runJSM m ctx
+
+
+instance CRUDSpaceCraft App where
+  listSpaceCraft       = runXHR App listSpaceCraftM
+  getSpaceCraft        = runXHR App . getSpaceCraftM
+  updateSpaceCraft x y = runXHR App $ updateSpaceCraftM x y
+  createSpaceCraft     = runXHR App . createSpaceCraftM
+  deleteSpaceCraft     = runXHR App . deleteSpaceCraftM
+
+
+(listSpaceCraftM :<|> getSpaceCraftM :<|> updateSpaceCraftM :<|> createSpaceCraftM :<|> deleteSpaceCraftM)
+  = client (Proxy @ API)
+
+
+app :: JSM ()
+app = fullPageSPA @ SPA runApp runParDiff (withHydration start) view getBody (const . start) routes
+
+
+main :: IO ()
+main = do
+  putStrLn "running app"
+  runJSorWarp 8080 app
diff --git a/servant-crud/Server.hs b/servant-crud/Server.hs
new file mode 100644
--- /dev/null
+++ b/servant-crud/Server.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeOperators              #-}
+{-# OPTIONS_GHC -fno-warn-missing-methods #-}
+
+
+module Main where
+
+
+import           Control.Monad.Reader
+import           Data.FileEmbed
+import           Data.Proxy
+import           Data.Text.Encoding
+import           Database.Beam
+import           Database.Beam.Sqlite
+import           Database.SQLite.Simple
+import           Network.Wai
+import           Network.Wai.Handler.Warp
+import           Options.Applicative
+import           Servant.API
+import           Servant.Server
+
+import           Shpadoinkle
+import           Shpadoinkle.Router.Server
+
+import           Types
+import           View
+
+
+data Options = Options
+  { assets :: FilePath
+  , port   :: Int
+  }
+
+
+newtype App a = App { runApp :: ReaderT Connection IO a }
+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader Connection)
+
+
+toHandler :: MonadIO m => Connection -> App ~> m
+toHandler c a = liftIO $ runReaderT (runApp a) c
+
+
+parser :: Parser Options
+parser = Options
+  <$> strOption   (long "assets" <> short 'a' <> metavar "FILEPATH")
+  <*> option auto (long "port"   <> short 'p' <> metavar "PORT" <> showDefault <> value 8080)
+
+
+options :: ParserInfo Options
+options = info (parser <**> helper) $
+    fullDesc <> progDesc "Servant CRUD Example"
+             <> header "Space craft manager as an example of Shpadoinkle"
+
+
+runSql :: (MonadIO m, MonadReader Connection m) => SqliteM ~> m
+runSql x = do conn <- ask; liftIO $ runBeamSqlite conn x
+
+
+newtype Noop a = Noop (JSM a)
+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadJSM)
+  deriving anyclass CRUDSpaceCraft
+
+
+instance CRUDSpaceCraft App where
+
+  listSpaceCraft =
+    runSql . runSelectReturningList . select . all_ $ _roster db
+
+  getSpaceCraft i =
+    runSql . runSelectReturningOne . select
+           . filter_ (\s -> val_ (SpaceCraftKey i) ==. primaryKey s) . all_ $ _roster db
+
+  updateSpaceCraft i SpaceCraftUpdate {..} =
+    runSql . runUpdate $ save (_roster db) $
+      SpaceCraft i _sku _description _serial _squadron _operable
+
+  deleteSpaceCraft i =
+    runSql . runDelete $ delete (_roster db) $ \sc -> val_ (SpaceCraftKey i) ==. primaryKey sc
+
+  createSpaceCraft SpaceCraftUpdate {..} =
+    runSql . fmap (_identity . head) . runInsertReturningList . insert (_roster db) $ insertExpressions
+        [ SpaceCraft default_ (val_ _sku) (val_ _description) (val_ _serial) (val_ _squadron) (val_ _operable) ]
+
+
+app :: Connection -> FilePath -> Application
+app conn root = serve (Proxy @ (API :<|> SPA)) $ serveApi :<|> serveSpa
+  where
+
+  serveApi :: Server API
+  serveApi = hoistServer (Proxy @ API) (toHandler conn)
+       $ listSpaceCraft
+    :<|> getSpaceCraft
+    :<|> updateSpaceCraft
+    :<|> createSpaceCraft
+    :<|> deleteSpaceCraft
+
+  serveSpa :: Server SPA
+  serveSpa = serveUI @ SPA root
+    (\r -> toHandler conn $ do
+      i <- start r; return . template i $ view @ Noop i) routes
+
+
+main :: IO ()
+main = do
+  Options {..} <- execParser options
+  conn <- open "roster.db"
+  execute_ conn . Query $ decodeUtf8 $(embedFile "./servant-crud/migrate.sql")
+  run port $ app conn assets
diff --git a/servant-crud/Types.hs b/servant-crud/Types.hs
new file mode 100644
--- /dev/null
+++ b/servant-crud/Types.hs
@@ -0,0 +1,271 @@
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE DuplicateRecordFields      #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE FunctionalDependencies     #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE UndecidableInstances       #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+
+module Types (module Types, module Types.Prim) where
+
+
+import           Control.Lens                      as Lens hiding (Context)
+import           Control.Lens.TH                   ()
+import           Control.Monad.Except
+import           Data.Aeson
+import           Data.Function
+import           Data.Maybe
+import           Data.Proxy
+import           Data.Text
+import           Database.Beam
+
+import           Servant.API                       hiding (Description)
+import           Shpadoinkle
+import qualified Shpadoinkle.Html                  as H
+import           Shpadoinkle.Router
+import           Shpadoinkle.Widgets.Form.Dropdown as Dropdown
+import           Shpadoinkle.Widgets.Table         as Table
+import           Shpadoinkle.Widgets.Types
+import           Shpadoinkle.Widgets.Validation
+
+import           Types.Prim
+
+
+data SpaceCraftT f = SpaceCraft
+  { _identity    :: Columnar f SpaceCraftId
+  , _sku         :: Columnar f SKU
+  , _description :: Columnar (Nullable f) Description
+  , _serial      :: Columnar f SerialNumber
+  , _squadron    :: Columnar f Squadron
+  , _operable    :: Columnar f Operable
+  } deriving (Generic, Beamable)
+
+
+instance Table SpaceCraftT where
+  newtype PrimaryKey SpaceCraftT f = SpaceCraftKey (Columnar f SpaceCraftId) deriving (Generic) deriving anyclass (Beamable)
+  primaryKey = SpaceCraftKey . _identity
+
+
+type SpaceCraft = SpaceCraftT Identity
+deriving instance Eq SpaceCraft
+deriving instance Ord SpaceCraft
+deriving instance Show SpaceCraft
+deriving instance ToJSON SpaceCraft
+deriving instance FromJSON SpaceCraft
+
+
+makeFieldsNoPrefix ''SpaceCraftT
+
+
+newtype DB f = DB { _roster :: f (TableEntity SpaceCraftT) } deriving (Generic) deriving anyclass (Database be)
+
+
+db :: DatabaseSettings be DB
+db = defaultDbSettings
+
+
+data SpaceCraftUpdate s = SpaceCraftUpdate
+  { _sku         :: Field s Text Input SKU
+  , _description :: Field s Text Input (Maybe Description)
+  , _serial      :: Field s Text Input SerialNumber
+  , _squadron    :: Field s Text (Dropdown 'One) Squadron
+  , _operable    :: Field s Text (Dropdown 'AtleastOne) Operable
+  } deriving Generic
+
+
+deriving instance Eq       (SpaceCraftUpdate 'Valid)
+deriving instance Ord      (SpaceCraftUpdate 'Valid)
+deriving instance Show     (SpaceCraftUpdate 'Valid)
+deriving instance ToJSON   (SpaceCraftUpdate 'Valid)
+deriving instance FromJSON (SpaceCraftUpdate 'Valid)
+
+deriving instance Eq       (SpaceCraftUpdate 'Edit)
+deriving instance Ord      (SpaceCraftUpdate 'Edit)
+deriving instance Show     (SpaceCraftUpdate 'Edit)
+deriving instance ToJSON   (SpaceCraftUpdate 'Edit)
+deriving instance FromJSON (SpaceCraftUpdate 'Edit)
+
+deriving instance Show     (SpaceCraftUpdate 'Errors)
+
+
+instance Validate SpaceCraftUpdate where
+  rules = SpaceCraftUpdate
+    { _sku         = positive <> nonZero
+    , _description = nonMEmpty
+    , _serial      = between (30, maxBound)
+    , _squadron    = maybe (throwError "Cannot be empty") pure
+    , _operable    = pure
+    }
+
+
+makeFieldsNoPrefix ''SpaceCraftUpdate
+
+
+data Roster = Roster
+  { _sort   :: SortCol [SpaceCraft]
+  , _search :: Input Search
+  , _table  :: [SpaceCraft]
+  }
+
+
+deriving instance Eq      Roster
+deriving instance Ord     Roster
+deriving instance Show    Roster
+deriving instance Generic Roster
+instance (ToJSON   (Table.Column [SpaceCraft])) => ToJSON   Roster
+instance (FromJSON (Table.Column [SpaceCraft])) => FromJSON Roster
+
+
+makeFieldsNoPrefix ''Roster
+
+
+emptyEditForm :: SpaceCraftUpdate 'Edit
+emptyEditForm = SpaceCraftUpdate
+  { _sku         = Input Clean 0
+  , _description = Input Clean Nothing
+  , _serial      = Input Clean 0
+  , _squadron    = fullOptions
+  , _operable    = fullOptionsMin
+  }
+
+
+data Frontend
+  = MEcho (Maybe Text)
+  | MList Roster
+  | MDetail (Maybe SpaceCraftId) (SpaceCraftUpdate 'Edit)
+  | M404
+  deriving (Eq, Ord, Show, Generic)
+
+
+instance (ToJSON   (Column [SpaceCraft])) => ToJSON   Frontend
+instance (FromJSON (Column [SpaceCraft])) => FromJSON Frontend
+
+
+makeLenses ''Frontend
+
+
+data Route
+  = REcho (Maybe Text)
+  | RList (Input Search)
+  | RNew
+  | RExisting SpaceCraftId
+  deriving (Eq, Ord, Show, Generic)
+
+
+makeLenses ''Route
+
+
+type API = "api" :> "space-craft" :> Get '[JSON] [SpaceCraft]
+      :<|> "api" :> "space-craft" :> Capture "id" SpaceCraftId :> Get '[JSON] (Maybe SpaceCraft)
+      :<|> "api" :> "space-craft" :> Capture "id" SpaceCraftId :> ReqBody '[JSON] (SpaceCraftUpdate 'Valid) :> Post '[JSON] ()
+      :<|> "api" :> "space-craft" :> ReqBody '[JSON] (SpaceCraftUpdate 'Valid) :> Put '[JSON] SpaceCraftId
+      :<|> "api" :> "space-craft" :> ReqBody '[JSON] SpaceCraftId :> Delete '[JSON] ()
+
+
+type SPA = "app" :> "echo" :> QueryParam "echo" Text :> Raw
+      :<|> "app" :> "new"  :> Raw
+      :<|> "app" :> "edit" :> Capture "id" SpaceCraftId :> Raw
+      :<|> "app" :> QueryParam "search" Search :> Raw
+      :<|> Raw
+
+
+routes :: SPA :>> Route
+routes = REcho
+    :<|> RNew
+    :<|> RExisting
+    :<|> RList . Input Clean . fromMaybe ""
+    :<|> RList (Input Clean "")
+
+
+deriving newtype instance ToHttpApiData   Search
+deriving newtype instance FromHttpApiData Search
+
+
+instance Routed SPA Route where
+  redirect = \case
+    REcho t     -> Redirect (Proxy @("app" :> "echo" :> QueryParam "echo" Text :> Raw)) ($ t)
+    RNew        -> Redirect (Proxy @("app" :> "new" :> Raw)) id
+    RExisting i -> Redirect (Proxy @("app" :> "edit" :> Capture "id" SpaceCraftId :> Raw)) ($ i)
+    RList s     -> Redirect (Proxy @("app" :> QueryParam "search" Search :> Raw)) ($ Just (_value s))
+
+
+class CRUDSpaceCraft m where
+  listSpaceCraft   :: m [SpaceCraft]
+  getSpaceCraft    :: SpaceCraftId -> m (Maybe SpaceCraft)
+  updateSpaceCraft :: SpaceCraftId -> SpaceCraftUpdate 'Valid -> m ()
+  createSpaceCraft :: SpaceCraftUpdate 'Valid -> m SpaceCraftId
+  deleteSpaceCraft :: SpaceCraftId -> m ()
+
+
+instance (MonadTrans t, Monad m, CRUDSpaceCraft m) => CRUDSpaceCraft (t m) where
+  listSpaceCraft     = lift listSpaceCraft
+  getSpaceCraft      = lift . getSpaceCraft
+  updateSpaceCraft x = lift . updateSpaceCraft x
+  createSpaceCraft   = lift . createSpaceCraft
+  deleteSpaceCraft   = lift . deleteSpaceCraft
+
+
+instance Humanize (Column [SpaceCraft]) where
+  humanize = \case
+    SKUT          -> "SKU"
+    DescriptionT  -> "Desc"
+    SerialNumberT -> "Serial #"
+    SquadronT     -> "Squadron"
+    OperableT     -> "Status"
+    ToolsT        -> ""
+
+
+data instance Column [SpaceCraft] =
+    SKUT | DescriptionT | SerialNumberT | SquadronT | OperableT | ToolsT
+    deriving (Eq, Ord, Show, Enum, Bounded, Generic, ToJSON, FromJSON)
+
+
+newtype instance Row [SpaceCraft] = SpaceCraftRow { unRow :: SpaceCraft }
+    deriving (Eq, Ord, Show)
+
+
+instance Tabular [SpaceCraft] where
+
+  type Effect [SpaceCraft] m = (MonadJSM m, CRUDSpaceCraft m)
+
+  toRows = fmap SpaceCraftRow
+
+  toCell xs (SpaceCraftRow SpaceCraft {..}) = \case
+    SKUT          -> present _sku
+    DescriptionT  -> present _description
+    SerialNumberT -> present _serial
+    SquadronT     -> present _squadron
+    OperableT     -> present _operable
+    ToolsT        ->
+      [ H.div "btn-group"
+        [ H.button [ H.class' "btn btn-sm btn-secondary", H.onClick' (xs <$ navigate @ SPA (RExisting _identity)) ] [ "Edit" ]
+        , H.button [ H.class' "btn btn-sm btn-secondary", H.onClick' (Prelude.filter (\x -> x ^. identity /= _identity) xs
+                          <$ deleteSpaceCraft _identity) ] [ "Delete" ]
+        ]
+      ]
+
+  sortTable (SortCol c d) = f $ case c of
+    SKUT          -> g sku
+    DescriptionT  -> g description
+    SerialNumberT -> g serial
+    SquadronT     -> g squadron
+    OperableT     -> g operable
+    ToolsT        -> \_ _ -> EQ
+    where f = case d of ASC -> id; DESC -> flip
+          g l = compare `on` Lens.view l . unRow
+
+
diff --git a/servant-crud/Types/Prim.hs b/servant-crud/Types/Prim.hs
new file mode 100644
--- /dev/null
+++ b/servant-crud/Types/Prim.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE DerivingVia                #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE UndecidableInstances       #-}
+
+
+module Types.Prim where
+
+
+import           Data.Aeson
+import           Data.String
+import           Data.Text
+import           Database.Beam
+
+#ifndef ghcjs_HOST_OS
+import           Database.Beam.Backend.SQL.SQL92
+import           Database.Beam.Sqlite
+import           Database.Beam.Sqlite.Syntax
+import           Database.SQLite.Simple.FromField
+#endif
+
+import           Servant.API                      hiding (Description)
+import           Shpadoinkle.Widgets.Types
+
+
+newtype SKU = SKU { unSKU :: Int  }
+  deriving stock Generic
+  deriving newtype (Real, Enum, Integral, Eq, Ord, Show, Read, Num, ToJSON, FromJSON)
+  deriving anyclass (Humanize, Present)
+#ifndef ghcjs_HOST_OS
+  deriving newtype (FromBackendRow Sqlite, HasSqlValueSyntax SqliteValueSyntax, HasSqlEqualityCheck Sqlite)
+#endif
+instance Semigroup SKU where SKU x <> SKU y = SKU $ x + y
+instance Monoid SKU where mempty = SKU 0
+
+
+newtype Description = Description { unDescription  :: Text }
+  deriving stock (Generic)
+  deriving newtype (Eq, Ord, Show, Read, IsString, ToJSON, FromJSON, Humanize, Semigroup, Monoid)
+  deriving anyclass (Present)
+#ifndef ghcjs_HOST_OS
+  deriving newtype (FromBackendRow Sqlite, HasSqlValueSyntax SqliteValueSyntax, HasSqlEqualityCheck Sqlite)
+#endif
+
+instance Humanize (Maybe Description) where
+  humanize = maybe "N/A" humanize
+
+
+newtype SerialNumber = SerialNumber { unSerialNumber :: Int  }
+  deriving stock Generic
+  deriving newtype (Enum, Bounded, Real, Integral, Eq, Ord, Show, Num, ToJSON, FromJSON)
+  deriving anyclass (Humanize, Present)
+#ifndef ghcjs_HOST_OS
+  deriving newtype (FromBackendRow Sqlite, HasSqlValueSyntax SqliteValueSyntax, HasSqlEqualityCheck Sqlite)
+#endif
+instance Semigroup SerialNumber where SerialNumber x <> SerialNumber y = SerialNumber $ x + y
+instance Monoid SerialNumber where mempty = SerialNumber 0
+
+
+newtype SpaceCraftId = SpaceCraftId { unSpaceCraftId :: Int }
+  deriving newtype ( Eq, Ord, Show, Num, ToJSON, FromJSON, FromHttpApiData, ToHttpApiData)
+  deriving anyclass (Humanize, Present)
+#ifndef ghcjs_HOST_OS
+  deriving newtype (FromBackendRow Sqlite, HasSqlValueSyntax SqliteValueSyntax, HasSqlEqualityCheck Sqlite)
+#endif
+
+
+data Operable = Operational | Inoperable
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Humanize, Present, Generic, ToJSON, FromJSON)
+#ifndef ghcjs_HOST_OS
+  deriving (FromBackendRow Sqlite, HasSqlEqualityCheck Sqlite)
+instance HasSqlValueSyntax be String => HasSqlValueSyntax be Operable where sqlValueSyntax = autoSqlValueSyntax
+#endif
+instance Semigroup Operable where (<>) = min
+instance Monoid Operable where mempty = maxBound
+
+
+data Squadron = AwayTeam | StrikeForce | Scout
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Present, Generic, ToJSON, FromJSON)
+#ifndef ghcjs_HOST_OS
+  deriving (FromBackendRow Sqlite)
+instance HasSqlValueSyntax be String => HasSqlValueSyntax be Squadron where sqlValueSyntax = autoSqlValueSyntax
+#endif
+instance Semigroup Squadron where x <> _ = x
+
+
+#ifndef ghcjs_HOST_OS
+instance FromField Operable where fromField = fmap read <$> fromField
+instance FromField Squadron where fromField = fmap read <$> fromField
+#endif
+
+
+instance Humanize Squadron where
+  humanize = \case
+    AwayTeam    -> "Away Team"
+    StrikeForce -> "Strike Force"
+    Scout       -> "Scouting"
+
+
+instance Humanize (Maybe Squadron) where
+  humanize = maybe "N/A" humanize
+
diff --git a/servant-crud/View.hs b/servant-crud/View.hs
new file mode 100644
--- /dev/null
+++ b/servant-crud/View.hs
@@ -0,0 +1,267 @@
+{-# LANGUAGE AllowAmbiguousTypes   #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ExtendedDefaultRules  #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE ImpredicativeTypes    #-}
+{-# LANGUAGE InstanceSigs          #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+
+module View where
+
+
+import           Control.Lens                      hiding (view)
+import           Control.Lens.Unsound              (lensProduct)
+import           Data.Coerce                       (Coercible)
+import           Data.Maybe                        (fromMaybe, isNothing)
+import           Data.String                       (IsString)
+import           Data.Text                         as T
+import           Shpadoinkle                       (Html, MonadJSM, text)
+import qualified Shpadoinkle.Html                  as H
+import           Shpadoinkle.Lens                  ((<%), (<+))
+import           Shpadoinkle.Router                (navigate, toHydration)
+import           Shpadoinkle.Widgets.Form.Dropdown as Dropdown (Dropdown (..),
+                                                                Theme (..),
+                                                                defConfig,
+                                                                dropdown)
+import qualified Shpadoinkle.Widgets.Form.Input    as Input
+import           Shpadoinkle.Widgets.Table         as Table
+import           Shpadoinkle.Widgets.Types         (Consideration, Considered,
+                                                    ConsideredChoice,
+                                                    Control (..), Field,
+                                                    Hygiene (..), Input (..),
+                                                    Pick (..), Present,
+                                                    Selected, Status (..),
+                                                    Toggle (..), Validated (..),
+                                                    fullset, fuzzySearch,
+                                                    getValid, humanize,
+                                                    validate, withOptions')
+
+import           Types
+
+
+default (Text, [])
+
+
+toEditForm :: SpaceCraft -> SpaceCraftUpdate 'Edit
+toEditForm sc = SpaceCraftUpdate
+  { _sku         = pure $ sc ^. sku
+  , _description = pure $ sc ^. description
+  , _serial      = pure $ sc ^. serial
+  , _squadron    = (sc ^. squadron) `withOptions'` fullset
+  , _operable    = (sc ^. operable) `withOptions'` fullset
+  }
+
+
+formGroup :: [Html m a] -> Html m a
+formGroup = H.div "form-group row"
+
+
+textControl
+  :: forall t m a
+   . Eq t => IsString t => Coercible Text t => MonadJSM m
+  => (forall v. Lens' (a v) (Field v Text Input (Maybe t)))
+  -> Text -> a 'Errors -> a 'Edit -> Html m (a 'Edit)
+textControl l msg errs ef = formGroup
+  [ H.label [ H.for' hName, H.class' "col-sm-2 col-form-label" ] [ text msg ]
+  , H.div "col-sm-10" $
+    [ ef <% l . mapping (fromMaybe "" `iso` noEmpty) $ Input.text
+      [ H.name' hName
+      , H.className ("form-control":controlClass (errs ^. l) (ef ^. l .hygiene))
+      ]
+    ]
+    <> invalid (errs ^. l) (ef ^. l . hygiene)
+  ] where hName = toHtmlName msg
+          noEmpty "" = Nothing
+          noEmpty x  = Just x
+
+
+intControl
+  :: forall n m a
+   . MonadJSM m => Integral n => Show n
+  => (forall v. Lens' (a v) (Field v Text Input n))
+  -> Text -> a 'Errors -> a 'Edit -> Html m (a 'Edit)
+intControl l msg errs ef = formGroup
+  [ H.label [ H.for' hName, H.class' "col-sm-2 col-form-label" ] [ text msg ]
+  , H.div "col-sm-10" $
+    [ ef <% l $ Input.integral @m
+      $ [ H.name' hName, H.step "1", H.min "0"
+        , H.className ("form-control":controlClass (errs ^. l) (ef ^. l .hygiene))
+        ]
+    ]
+    <> invalid (errs ^. l) (ef ^. l . hygiene)
+  ] where hName = toHtmlName msg
+
+
+selectControl
+  :: forall p x m a
+   . MonadJSM m => Control (Dropdown p)
+  => Considered p ~ Maybe => Consideration ConsideredChoice p
+  => Present (Selected p x) => Present x => Ord x
+  => (forall v. Lens' (a v) (Field v Text (Dropdown p) x))
+  -> Text -> a 'Errors -> a 'Edit -> Html m (a 'Edit)
+selectControl l msg errs ef = formGroup
+  [ H.label [ H.for' (toHtmlName msg)
+            , H.class' "col-sm-2 col-form-label" ] [ text msg ]
+  , H.div "col-sm-10" $
+    [ ef <% l $ dropdown bootstrap defConfig ]
+    <> invalid (errs ^. l) (ef ^. l . hygiene)
+  ]
+  where
+  bootstrap Dropdown {..} = Dropdown.Theme
+    { _wrapper = H.div
+      [ H.className [ ("dropdown", True)
+                    , ("show", _toggle == Open) ]
+      ]
+    , _header  = pure . H.button
+      [ H.className ([ "btn", "btn-secondary", "dropdown-toggle" ] :: [Text])
+      , H.type' "button"
+      ]
+    , _list    = H.div
+      [ H.className [ ("dropdown-menu", True)
+                    , ("show", _toggle == Open) ]
+      ]
+    , _item    = H.a [ H.className "dropdown-item"
+                     , H.textProperty "style" "cursor:pointer" ]
+    }
+
+
+controlClass :: Validated e a -> Hygiene -> [Text]
+controlClass (Invalid _ _) Dirty = ["is-invalid"]
+controlClass (Validated _) Dirty = ["is-valid"]
+controlClass _ Clean             = []
+
+
+invalid :: Validated Text a -> Hygiene -> [ Html m b ]
+invalid (Invalid err errs) Dirty = (\e -> H.div "invalid-feedback" [ text e ]) <$> err:errs
+invalid _                  _     = []
+
+
+toHtmlName :: Text -> Text
+toHtmlName = toLower . replace " " "-"
+
+
+editForm :: (CRUDSpaceCraft m, MonadJSM m) => Maybe SpaceCraftId -> SpaceCraftUpdate 'Edit -> Html m (SpaceCraftUpdate 'Edit)
+editForm mid ef = H.div_
+
+  [ intControl    @SKU                   sku         "SKU"           errs ef
+  , textControl   @Description           description "Description"   errs ef
+  , intControl    @SerialNumber          serial      "Serial Number" errs ef
+  , selectControl @'One @Squadron        squadron    "Squadron"      errs ef
+  , selectControl @'AtleastOne @Operable operable    "Operable"      errs ef
+  , H.div "d-flex flex-row justify-content-end"
+
+    [ H.button
+      [ H.onClick' (ef <$ navigate @SPA (RList mempty))
+      , H.class' "btn btn-secondary"
+      ] [ "Cancel" ]
+
+    , H.button
+      [ H.onClick' $ case isValid of
+         Nothing -> return ef
+         Just up -> do
+           case mid of Nothing  -> () <$ createSpaceCraft up
+                       Just sid -> updateSpaceCraft sid up
+           ef <$ navigate @SPA (RList mempty)
+      , H.class' "btn btn-primary"
+      , H.disabled $ isNothing isValid
+      ] [ "Save" ]
+
+    ]
+  ] where errs = validate ef
+          isValid = getValid errs
+
+
+start :: (Monad m, CRUDSpaceCraft m) => Route -> m Frontend
+start = \case
+  RList s     -> MList . Roster (SortCol SKUT ASC) s <$> listSpaceCraft
+  REcho t     -> return $ MEcho t
+  RNew        -> return $ MDetail Nothing emptyEditForm
+  RExisting i -> do
+    mcraft <- getSpaceCraft i
+    return $ case mcraft of
+     Just craft -> MDetail (Just i) $ toEditForm craft
+     _          -> M404
+
+
+tableCfg :: Table.Theme m [SpaceCraft]
+tableCfg = mempty
+  { tableProps = [ H.class' "table table-striped table-bordered" ]
+  , tdProps    = \case
+      ToolsT -> [ H.width 1 ]
+      _ -> "align-middle"
+  }
+
+
+fuzzy :: [SpaceCraft -> Text]
+fuzzy = flip (^.) <$>
+  [ sku         . to humanize
+  , description . to humanize
+  , serial      . to humanize
+  , squadron    . to humanize
+  , operable    . to humanize
+  ]
+
+
+view :: (MonadJSM m, CRUDSpaceCraft m) => Frontend -> Html m Frontend
+view fe = case fe of
+
+  MList r -> MList <$> H.div "container-fluid"
+   [ H.div "row justify-content-between align-items-center"
+     [ H.h2_ [ "Space Craft Roster" ]
+     , H.div [ H.class' "input-group"
+             , H.textProperty "style" ("width:300px" :: Text)
+             ]
+       [ r <% search $ Input.search [ H.class' "form-control", H.placeholder "Search" ]
+       , H.div "input-group-append mr-3"
+         [ H.button [ H.onClick' (r <$ navigate @SPA RNew), H.class' "btn btn-primary" ] [ "Register" ]
+         ]
+       ]
+     ]
+   , r <+ lensProduct table sort $ Table.viewWith tableCfg
+    (r ^. table . to (fuzzySearch fuzzy $ r ^. search . value))
+    (r ^. sort)
+   ]
+
+  MDetail sid form -> MDetail sid <$> H.div "row"
+    [ H.div "col-sm-8 offset-sm-2"
+      [ H.h2_ [ text $ maybe "Register New Space Craft" (const "Edit Space Craft") sid
+              ]
+      , editForm sid form
+      ]
+    ]
+
+  MEcho t -> H.div_
+    [ maybe (text "Erie silence") text t
+    , H.a [ H.onClick' (fe <$ navigate @SPA (RList $ Input Clean "")) ] [ "Go To Space Craft Roster" ]
+    ]
+
+  M404 -> text "404"
+
+
+template :: Frontend -> Html m a -> Html m a
+template fe stage = H.html_
+  [ H.head_
+    [ H.link'
+      [ H.rel "stylesheet"
+      , H.href "https://cdn.usebootstrap.com/bootstrap/4.3.1/css/bootstrap.min.css"
+      ]
+    , H.meta [ H.charset "ISO-8859-1" ] []
+    , toHydration fe
+    , H.script [ H.src "/all.js" ] []
+    ]
+  , H.body_
+    [ stage
+    ]
+  ]
diff --git a/widgets/Widgets.hs b/widgets/Widgets.hs
new file mode 100644
--- /dev/null
+++ b/widgets/Widgets.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE RecordWildCards      #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+
+module Main where
+
+
+import           Control.Monad.IO.Class            (liftIO)
+import           Data.Text
+import           Prelude                           hiding (div)
+
+import           Shpadoinkle
+import           Shpadoinkle.Backend.ParDiff
+import           Shpadoinkle.Html                  as H (a, button, className,
+                                                         div, div_, href, id',
+                                                         link', rel,
+                                                         textProperty, type')
+import           Shpadoinkle.Html.Utils
+import           Shpadoinkle.Widgets.Form.Dropdown as Dropdown
+import           Shpadoinkle.Widgets.Types
+
+
+default (Text)
+
+
+data Cheese = Cheddar | Munster | Mozzeralla
+  deriving (Show, Eq, Ord, Bounded, Enum)
+
+
+instance Humanize Cheese where
+  humanize = pack . show
+
+
+instance Humanize (Maybe Cheese) where
+  humanize = maybe "Please Select" humanize
+
+
+data Model = Model
+  { _pickOne        :: Dropdown 'One Cheese
+  , _pickAtleastOne :: Dropdown 'AtleastOne Cheese
+  } deriving (Eq, Show)
+
+
+view :: MonadJSM m => Model -> Html m Model
+view m = div_
+  [ link' [ rel "stylesheet", href "https://stackpath.bootstrapcdn.com/bootstrap/4.3.1/css/bootstrap.min.css" ]
+  , (\x -> m {_pickOne = x}) <$>
+    dropdown bootstrap defConfig { _attrs = [ id' "One" ] } (_pickOne m)
+  , (\x -> m {_pickAtleastOne = x}) <$>
+    dropdown bootstrap defConfig { _attrs = [ id' "AtleastOne" ] } (_pickAtleastOne m)
+  ]
+  where
+  bootstrap Dropdown {..} = Dropdown.Theme
+    { _wrapper = div
+      [ className [ ("dropdown", True)
+                  , ("show", _toggle == Open) ]
+      ]
+    , _header  = pure . button
+      [ className ([ "btn", "btn-secondary", "dropdown-toggle" ] :: [Text])
+      , type' "button"
+      ]
+    , _list    = div
+      [ className [ ("dropdown-menu", True)
+                  , ("show", _toggle == Open) ]
+      ]
+    , _item    = a [ className "dropdown-item"
+                   , textProperty "style" "cursor:pointer" ]
+    }
+
+
+
+initial :: Model
+initial = Model fullOptions $ minBound `withOptions'` fullset
+
+
+app :: JSM ()
+app = do
+  model <- liftIO $ newTVarIO initial
+  shpadoinkle id runParDiff initial model view getBody
+
+
+main :: IO ()
+main = runJSorWarp 8080 app