diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Shpadoinkle Widgets, 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,22 @@
+# Shpadoinkle Widgets
+
+[![Goldwater](https://gitlab.com/fresheyeball/Shpadoinkle/badges/master/pipeline.svg)](https://gitlab.com/fresheyeball/Shpadoinkle)
+[![Hackage](https://img.shields.io/hackage/v/Shpadoinkle-widgets.svg)](https://hackage.haskell.org/package/Shpadoinkle-widgets)
+[![Hackage Deps](https://img.shields.io/hackage-deps/v/Shpadoinkle-widgets.svg)](http://packdeps.haskellers.com/reverse/Shpadoinkle-widgets)
+[![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/Shpadoinkle-widgets/badge)](https://matrix.hackage.haskell.org/#/package/Shpadoinkle-widgets)
+
+There are many shared abstractions between various UI's that represent
+themselves in frameworks, and applications. This package provides a useful
+subset of these concepts as types. Along with implimentations consuming
+these types.
+
+Docs are very WIP right now, and themeing via property injection is still being explored.
+
+## Current Widgets
+
+- Dropdown
+- Textual Input
+- Numeric Input
+- Data Table
+
+
diff --git a/Shpadoinkle-widgets.cabal b/Shpadoinkle-widgets.cabal
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle-widgets.cabal
@@ -0,0 +1,76 @@
+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: da8a19caa819b338cdab73065a3f5e9112de2440da5ecb431080860f51889144
+
+name:           Shpadoinkle-widgets
+version:        0.0.0.1
+synopsis:       A collection of common reusable types and components.
+description:    There are many shared abstractions between various UI's that represent themselves in frameworks, and applications. This package provides a useful subset of these concepts as types. Along with implimentations consuming these types.
+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
+
+library
+  exposed-modules:
+      Shpadoinkle.Widgets.Form.Input
+      Shpadoinkle.Widgets.Form.Dropdown
+      Shpadoinkle.Widgets.Table
+      Shpadoinkle.Widgets.Types
+      Shpadoinkle.Widgets.Types.Choice
+      Shpadoinkle.Widgets.Types.Core
+      Shpadoinkle.Widgets.Types.Form
+      Shpadoinkle.Widgets.Types.Physical
+      Shpadoinkle.Widgets.Types.Remote
+      Shpadoinkle.Widgets.Types.Search
+      Shpadoinkle.Widgets.Validation
+  other-modules:
+      Paths_Shpadoinkle_widgets
+  hs-source-dirs:
+      ./.
+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities
+  build-depends:
+      Shpadoinkle <0.1
+    , Shpadoinkle-html <0.1
+    , aeson >=1.4.4 && <1.5
+    , base >=4.12.0 && <4.13
+    , compactable >=0.1.2 && <0.2
+    , containers >=0.6.0 && <0.7
+    , edit-distance >=0.2.2 && <0.3
+    , email-validate >=2.3.2 && <2.4
+    , jsaddle >=0.9.7 && <0.20
+    , mtl >=2.2.2 && <2.3
+    , stm >=2.5.0 && <2.6
+    , template-haskell >=2.14.0 && <2.15
+    , text >=1.2.3 && <1.3
+    , unliftio >=0.2.12 && <0.3
+  default-language: Haskell2010
+
+test-suite unit
+  type: exitcode-stdio-1.0
+  main-is: Test.hs
+  other-modules:
+      Paths_Shpadoinkle_widgets
+  hs-source-dirs:
+      tests
+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities
+  build-depends:
+      QuickCheck
+    , Shpadoinkle-widgets
+    , base >=4.12.0 && <4.13
+    , containers
+    , hspec
+  default-language: Haskell2010
diff --git a/Shpadoinkle/Widgets/Form/Dropdown.hs b/Shpadoinkle/Widgets/Form/Dropdown.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Form/Dropdown.hs
@@ -0,0 +1,192 @@
+{-# LANGUAGE DataKinds                 #-}
+{-# LANGUAGE DeriveGeneric             #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE ExtendedDefaultRules      #-}
+{-# LANGUAGE FlexibleContexts          #-}
+{-# LANGUAGE FlexibleInstances         #-}
+{-# LANGUAGE InstanceSigs              #-}
+{-# LANGUAGE LambdaCase                #-}
+{-# LANGUAGE MultiParamTypeClasses     #-}
+{-# LANGUAGE OverloadedStrings         #-}
+{-# LANGUAGE RankNTypes                #-}
+{-# LANGUAGE RecordWildCards           #-}
+{-# LANGUAGE ScopedTypeVariables       #-}
+{-# LANGUAGE StandaloneDeriving        #-}
+{-# LANGUAGE TypeFamilies              #-}
+{-# LANGUAGE UndecidableInstances      #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+
+module Shpadoinkle.Widgets.Form.Dropdown where
+
+
+import           Control.Compactable
+import           Data.Aeson
+import           Data.Text
+import           GHC.Generics
+import           Prelude                   hiding (div)
+
+
+import           Shpadoinkle
+import           Shpadoinkle.Html          hiding (p, s, s', selected)
+import           Shpadoinkle.Keyboard
+import           Shpadoinkle.Widgets.Types
+
+
+default (Text)
+
+
+data Dropdown p a = Dropdown
+  { _considered :: ConsideredChoice p a
+  , _toggle     :: Toggle
+  }
+
+
+deriving instance (Show (Selected p a), Show (Considered p a), Show a)        => Show (Dropdown p a)
+deriving instance (Read (Selected p a), Read (Considered p a), Read a, Ord a) => Read (Dropdown p a)
+deriving instance (Eq   (Selected p a), Eq   (Considered p a), Eq a)          => Eq   (Dropdown p a)
+deriving instance (Ord  (Selected p a), Ord  (Considered p a), Ord a)         => Ord  (Dropdown p a)
+deriving instance Generic (Dropdown p a)
+instance (ToJSON a,   ToJSON (Selected p a),   ToJSON (Considered p a))          => ToJSON   (Dropdown p a)
+instance (FromJSON a, FromJSON (Selected p a), FromJSON (Considered p a), Ord a) => FromJSON (Dropdown p a)
+
+
+instance Control (Dropdown 'One) where
+  type Val (Dropdown 'One) a = Maybe a
+  hygiene  :: Applicative f          => (Hygiene -> f Hygiene)   -> Dropdown 'One a -> f (Dropdown 'One a)
+  hygiene f d = (\x -> d {_toggle = Closed x }) <$> f (togHygiene $ _toggle d)
+  value    :: (Applicative f, Ord a) => (Maybe a -> f (Maybe a)) -> Dropdown 'One a -> f (Dropdown 'One a)
+  value   f d = maybe d (select' d) <$> f (selected d)
+
+instance Control (Dropdown 'AtleastOne) where
+  hygiene f d = (\x -> d {_toggle = Closed x }) <$> f (togHygiene $ _toggle d)
+  value f d = select' d <$> f (selected d)
+
+
+instance (Consideration ConsideredChoice p, Ord a)
+    => IsToggle (Dropdown p a) where
+  close  p = shrug $ p { _toggle = close  (_toggle p) }
+  toggle p = shrug $ p { _toggle = toggle (_toggle p) }
+  open   p = shrug $ p { _toggle = open   (_toggle p) }
+
+
+newtype Config m = Config
+  { _attrs :: forall a. [(Text, Prop m a)] }
+
+
+defConfig :: Config m
+defConfig = Config []
+
+
+instance (Compactable (ConsideredChoice p)) => Compactable (Dropdown p) where
+  compact (Dropdown c t) = Dropdown (compact c) t
+  separate (Dropdown c t) = let (l,r) = separate c in (Dropdown l t, Dropdown r t)
+  filter p (Dropdown c t) = Dropdown (Control.Compactable.filter p c) t
+  partition p (Dropdown c t) = let (l, r) = Control.Compactable.partition p c in (Dropdown l t, Dropdown r t)
+
+
+instance Semigroup (ConsideredChoice p a) => Semigroup (Dropdown p a) where
+  Dropdown c t <> Dropdown c' t' = Dropdown (c <> c') (t <> t')
+
+
+instance Monoid (ConsideredChoice p a) => Monoid (Dropdown p a) where
+  mempty = Dropdown mempty mempty
+
+
+instance SetLike (ConsideredChoice p) => SetLike (Dropdown p) where
+  toSet = toSet . _considered
+  smap f (Dropdown c t) = Dropdown (smap f c) t
+  valid (Dropdown c _) = valid c
+
+
+instance Consideration ConsideredChoice p => Selection Dropdown p where
+  select  (Dropdown c t) x = close $ Dropdown (select c x) t
+  select' (Dropdown c t) x = close $ Dropdown (select' c x) t
+  unselected = unselected . _considered
+  selected   = selected . _considered
+  withOptions x xs  = Dropdown (x `withOptions` xs) mempty
+  withOptions' x xs = Dropdown (x `withOptions'` xs) mempty
+
+
+instance (Consideration ConsideredChoice p, Deselection ConsideredChoice p)
+    => Deselection Dropdown p where
+  noselection xs = Dropdown (noselection xs) mempty
+  deselect (Dropdown c t) = close $ Dropdown (deselect c) t
+
+
+instance Consideration ConsideredChoice p => Consideration Dropdown p where
+  consider  x (Dropdown c t) = Dropdown (consider x c) t
+  consider' x (Dropdown c t) = Dropdown (consider' x c) t
+  choose (Dropdown c t) = Dropdown (choose c) t
+  choice (Dropdown c _) = choice c
+  considered (Dropdown c _) = considered c
+  shrug (Dropdown c xs) = Dropdown (shrug c) xs
+
+
+data Theme m = Theme
+  { _wrapper :: forall a. [Html m a] -> Html m a
+  , _header  :: forall a. [Html m a] -> [Html m a]
+  , _list    :: forall a. [Html m a] -> Html m a
+  , _item    :: forall a. [Html m a] -> Html m a
+  }
+
+
+semantic :: Dropdown p b -> Theme m
+semantic Dropdown {..} = Theme
+  { _wrapper = div
+    [ className [ ("dropdown", True)
+                , ("ui",       True)
+                , ("active", _toggle == Open) ]
+    ]
+  , _header  = \cs ->
+    [ div [ class' "text" ] cs
+    , i' [ className ["dropdown", "icon"] ]
+    ]
+  , _list    = div
+    [ className [ "menu"
+                , "transition" ]
+    ]
+  , _item    = div [ className "item" ]
+  }
+
+
+act :: ( Considered p ~ Maybe
+       , Consideration ConsideredChoice p
+       , Consideration Dropdown p
+       , Ord a)
+    => Dropdown p a -> Dropdown p a
+act x | _toggle x == Open =
+  close $ case considered x of
+    Just _ -> choose x
+    _      -> x
+act x = open x
+
+
+dropdown ::
+  ( Considered p ~ Maybe
+  , Consideration Dropdown p
+  , Consideration ConsideredChoice p
+  , Present (Selected p a), Present a, Ord a
+  , MonadJSM m
+  ) => (forall b. Dropdown p b -> Theme m)
+    -> Config m -> Dropdown p a -> Html m (Dropdown p a)
+dropdown toTheme Config {..} x =
+  let
+    Theme {..} = toTheme x
+  in injectProps
+  ([onKeyup' $ \case
+    Enter     -> act x
+    UpArrow   -> considerPrev x
+    DownArrow -> considerNext x
+    _ -> x
+  , onClick $ act x
+  , tabbable
+  ] ++ _attrs) . _wrapper $
+  (_header . present $ selected x) ++
+  [ _list $ (\y -> injectProps
+    [ onMouseover $ consider' y x
+    , onFocus     $ consider' y x
+    , onClick     $ select' x y
+    , tabbable
+    ] . _item $ present y) <$> toList (unselected x)
+  ]
diff --git a/Shpadoinkle/Widgets/Form/Input.hs b/Shpadoinkle/Widgets/Form/Input.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Form/Input.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+
+module Shpadoinkle.Widgets.Form.Input where
+
+
+import           Data.Coerce
+import           Data.Text
+import           Data.Text.Read
+
+import           Shpadoinkle                      hiding (text)
+import           Shpadoinkle.Html                 as Html
+import           Shpadoinkle.Widgets.Types.Core
+import           Shpadoinkle.Widgets.Types.Form   as Form
+import           Shpadoinkle.Widgets.Types.Search
+
+
+type Config m a = Props m (Input a)
+
+
+mkInput :: MonadJSM m => Text -> (Text -> a) -> (a -> Text) -> Config m a -> Input a -> Html m (Input a)
+mkInput t to from attrs inp = Html.input
+  ( Html.value (from $ Form._value inp)
+  : Html.onInput (Input Dirty . to)
+  : Html.type' t
+  : attrs ) []
+
+
+fractional :: MonadJSM m => Fractional n => Show n => Config m n -> Input n -> Html m (Input n)
+fractional cfg inp = mkInput "number" to (pack . show) cfg inp where
+  to t = case double t of
+    Right (d,"") -> realToFrac d
+    _            -> _value inp
+
+
+integral :: MonadJSM m => Integral n => Show n => Config m n -> Input n -> Html m (Input n)
+integral cfg inp = mkInput "number" to (pack . show) cfg inp where
+  to t = case double t of
+    Right (d,"") -> round d
+    _            -> _value inp
+
+
+search :: MonadJSM m => Config m Search -> Input Search -> Html m (Input Search)
+search = mkInput "search" coerce coerce
+
+
+text :: forall m t. (MonadJSM m, Coercible Text t) => Config m t -> Input t -> Html m (Input t)
+text = mkInput "text" coerce coerce
diff --git a/Shpadoinkle/Widgets/Table.hs b/Shpadoinkle/Widgets/Table.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Table.hs
@@ -0,0 +1,151 @@
+{-# LANGUAGE ConstraintKinds        #-}
+{-# LANGUAGE DataKinds              #-}
+{-# LANGUAGE DeriveAnyClass         #-}
+{-# LANGUAGE DeriveFunctor          #-}
+{-# LANGUAGE DeriveGeneric          #-}
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE OverloadedStrings      #-}
+{-# LANGUAGE PolyKinds              #-}
+{-# LANGUAGE RecordWildCards        #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
+{-# LANGUAGE StandaloneDeriving     #-}
+{-# LANGUAGE TupleSections          #-}
+{-# LANGUAGE TypeFamilies           #-}
+{-# LANGUAGE UndecidableInstances   #-}
+
+
+module Shpadoinkle.Widgets.Table
+  ( Sort (..)
+  , SortCol (..)
+  , compareOn
+  , negateSort
+  , Tabular (..)
+  , Column, Row
+  , Theme (..)
+  , toggleSort
+  , view
+  , viewWith
+  ) where
+
+
+import           Data.Aeson
+import           Data.Kind
+import           Data.List                 (sortBy)
+import           Data.Text
+import           GHC.Generics
+
+import           Shpadoinkle
+import           Shpadoinkle.Html          hiding (a, a', max, min, s, s')
+import qualified Shpadoinkle.Html          as Html
+import           Shpadoinkle.Widgets.Types
+
+
+data Sort = ASC | DESC
+  deriving (Show, Eq, Ord, Bounded, Enum, Generic, ToJSON, FromJSON)
+
+
+instance Semigroup Sort where (<>) = min
+instance Monoid Sort where mempty = maxBound
+
+
+negateSort :: Sort -> Sort
+negateSort ASC  = DESC
+negateSort DESC = ASC
+
+
+data SortCol a = SortCol (Column a) Sort
+deriving instance Show (Column a) => Show (SortCol a)
+deriving instance Eq   (Column a) => Eq   (SortCol a)
+deriving instance Ord  (Column a) => Ord  (SortCol a)
+deriving instance Functor Column => Functor SortCol
+deriving instance Generic (SortCol a)
+instance (ToJSON   (Column a)) => ToJSON   (SortCol a)
+instance (FromJSON (Column a)) => FromJSON (SortCol a)
+
+
+instance Ord (Column a) => Semigroup (SortCol a) where
+  SortCol a s <> SortCol a' s' = SortCol (max a a') (min s s')
+
+
+instance ( Bounded (Column a)
+         , Ord (Column a)
+         , Enum (Column a)
+         ) => Monoid (SortCol a) where
+  mempty = SortCol minBound maxBound
+
+
+compareOn :: Ord a => Sort -> a -> a -> Ordering
+compareOn DESC = compare
+compareOn ASC  = flip compare
+
+
+data family Column (a :: Type) :: Type
+data family Row    (a :: Type) :: Type
+
+
+class Tabular a where
+  type Effect a (m :: Type -> Type) :: Constraint
+  type Effect a m = Applicative m
+  toRows    :: a -> [Row a]
+  toCell    :: Effect a m => a -> Row a -> Column a -> [Html m a]
+  sortTable :: SortCol a -> Row a -> Row a -> Ordering
+
+
+toggleSort :: Eq (Column a) => Column a -> SortCol a -> SortCol a
+toggleSort c (SortCol c' s) = if c == c' then SortCol c $ negateSort s else SortCol c mempty
+
+
+data Theme m a = Theme
+  { tableProps ::             [(Text, Prop m (a, SortCol a))]
+  , headProps  ::             [(Text, Prop m (a, SortCol a))]
+  , thProps    :: Column a -> [(Text, Prop m (a, SortCol a))]
+  , bodyProps  ::             [(Text, Prop m (a, SortCol a))]
+  , tdProps    :: Column a -> [(Text, Prop m a)]
+  } deriving Generic
+
+
+instance Semigroup (Theme m a) where
+  Theme v w x y z <> Theme v' w' x' y' z' =
+    Theme (v <> v') (w <> w') (x <> x') (y <> y') (z <> z')
+instance Monoid (Theme m a) where
+  mempty = Theme mempty mempty mempty mempty mempty
+
+
+view :: forall m a.
+  ( Tabular a
+  , Effect a m
+  , Applicative m
+  , Humanize (Column a)
+  , Bounded  (Column a)
+  , Ord      (Column a)
+  , Enum     (Column a) )
+  => a -> SortCol a -> Html m (a, SortCol a)
+view = viewWith mempty
+
+
+viewWith :: forall m a.
+  ( Tabular a
+  , Effect a m
+  , Applicative m
+  , Humanize (Column a)
+  , Bounded  (Column a)
+  , Ord      (Column a)
+  , Enum     (Column a) )
+  => Theme m a -> a -> SortCol a -> Html m (a, SortCol a)
+viewWith Theme {..} xs s@(SortCol sorton sortorder) =
+  table tableProps
+    [ thead headProps [ tr_ $ cth_ <$> [minBound..maxBound] ]
+    , tbody bodyProps $ do
+        row <- sortBy (sortTable s) (toRows xs)
+        return . (fmap (, s)) . tr_ $ (\c -> td (tdProps c) $ toCell xs row c) <$> [minBound..maxBound]
+    ]
+
+  where
+
+  cth_ c = th (thProps c) . pure . Html.a [ onClick (xs, toggleSort c s) ]
+         . mappend [ text (humanize c) ] . pure . text $
+          if c == sorton then
+            case sortorder of ASC -> "↑"; DESC -> "↓"
+          else ""
diff --git a/Shpadoinkle/Widgets/Types.hs b/Shpadoinkle/Widgets/Types.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Types.hs
@@ -0,0 +1,16 @@
+module Shpadoinkle.Widgets.Types
+  ( module Shpadoinkle.Widgets.Types.Core
+  , module Shpadoinkle.Widgets.Types.Choice
+  , module Shpadoinkle.Widgets.Types.Form
+  , module Shpadoinkle.Widgets.Types.Physical
+  , module Shpadoinkle.Widgets.Types.Remote
+  , module Shpadoinkle.Widgets.Types.Search
+  ) where
+
+
+import           Shpadoinkle.Widgets.Types.Choice
+import           Shpadoinkle.Widgets.Types.Core
+import           Shpadoinkle.Widgets.Types.Form
+import           Shpadoinkle.Widgets.Types.Physical
+import           Shpadoinkle.Widgets.Types.Remote
+import           Shpadoinkle.Widgets.Types.Search
diff --git a/Shpadoinkle/Widgets/Types/Choice.hs b/Shpadoinkle/Widgets/Types/Choice.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Types/Choice.hs
@@ -0,0 +1,402 @@
+{-# LANGUAGE AllowAmbiguousTypes   #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DefaultSignatures     #-}
+{-# LANGUAGE DeriveGeneric         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE IncoherentInstances   #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE StandaloneDeriving    #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+
+module Shpadoinkle.Widgets.Types.Choice where
+
+
+import           Control.Applicative
+import           Control.Compactable
+import           Data.Aeson
+import qualified Data.Foldable       as F
+import           Data.Kind
+import qualified Data.List.NonEmpty  as NE
+import           Data.Maybe
+import           Data.Set            as Set
+import           GHC.Generics
+
+
+data Pick   = One | AtleastOne | Many
+
+
+type family Selected (p :: Pick) (a :: Type) :: Type where
+  Selected 'One        a = Maybe a
+  Selected 'AtleastOne a = a
+  Selected 'Many       a = Set a
+
+
+data Choice (p :: Pick) a = Choice
+  { _selected :: Selected p a
+  , _options  :: Set a
+  }
+
+
+deriving instance (Show (Selected p a), Show a)        => Show (Choice p a)
+deriving instance (Read (Selected p a), Read a, Ord a) => Read (Choice p a)
+deriving instance (Eq   (Selected p a), Eq a)          => Eq   (Choice p a)
+deriving instance (Ord  (Selected p a), Ord a)         => Ord  (Choice p a)
+deriving instance Generic (Choice p a)
+instance (ToJSON   (Selected p a), ToJSON   a)        => ToJSON   (Choice p a)
+instance (FromJSON (Selected p a), FromJSON a, Ord a) => FromJSON (Choice p a)
+
+
+instance (Bounded a, Enum a) => Bounded (Choice 'AtleastOne a) where
+  minBound = Choice minBound fullset
+  maxBound = Choice maxBound fullset
+
+
+instance (Bounded a, Enum a) => Enum (Choice 'AtleastOne a) where
+  toEnum n = Choice (toEnum n) fullset
+  fromEnum (Choice x _) = fromEnum x
+
+
+instance Foldable (Choice 'One)         where foldr f x (Choice y xs) = Set.foldr f (Prelude.foldr f x y) xs
+instance Foldable (Choice 'AtleastOne)  where foldr f x (Choice y xs)  = Set.foldr f (f y x) xs
+instance Foldable (Choice 'Many)        where foldr f x (Choice y xs)  = Set.foldr f (Set.foldr f x y) xs
+
+
+instance Ord a => Semigroup (Choice 'One a)  where
+  Choice (Just x) _ <> Choice _ ys | Set.member x ys = Choice (Just x) ys
+  _                 <> y           = y
+instance Ord a => Semigroup (Choice 'AtleastOne a)  where Choice x _ <> Choice y ys = if Set.member x ys then Choice x ys else Choice y ys
+instance Ord a => Semigroup (Choice 'Many a) where Choice x _ <> Choice y ys = Choice (Set.intersection x ys <> y) ys
+instance Ord a => Monoid    (Choice 'One  a) where mempty = noselection (mempty :: Set a)
+instance Ord a => Monoid    (Choice 'Many a) where mempty = noselection (mempty :: Set a)
+
+
+instance Compactable (Choice 'One) where
+  compact (Choice x xs) = Choice (compact x) (compact xs)
+  separate (Choice x xs) = let (l,r) = separate xs; (l',r') = separate x in (Choice l' l, Choice r' r)
+  filter p (Choice x xs) = Choice (Control.Compactable.filter p x) $ Set.filter p xs
+  partition p (Choice x xs) = let (l, r) = Set.partition p xs; (l',r') = Control.Compactable.partition p x in (Choice l' l, Choice r' r)
+
+
+instance Compactable (Choice 'Many) where
+  compact (Choice x xs) = Choice (compact x) (compact xs)
+  separate (Choice x xs) = let (l,r) = separate xs; (l',r') = separate x in (Choice l' l, Choice r' r)
+  filter p (Choice x xs) = Choice (Control.Compactable.filter p x) $ Set.filter p xs
+  partition p (Choice x xs) = let (l, r) = Set.partition p xs; (l',r') = Control.Compactable.partition p x in (Choice l' l, Choice r' r)
+
+
+class SetLike f where
+  -- must be injective
+  toSet :: Ord a => f a -> Set a
+  smap  :: Ord b => (a -> b) -> f a -> f b
+  valid :: Ord a => f a -> Bool
+
+instance SetLike Set where
+  toSet = id
+  smap  = Set.map
+  valid = Set.valid
+
+instance SetLike Maybe where
+  toSet = maybe mempty Set.singleton
+  smap  = fmap
+  valid = const True
+
+instance SetLike (Choice 'One) where
+  toSet (Choice x xs) = toSet x <> xs
+  smap f (Choice x xs) = Choice (f <$> x)     (Set.map f xs)
+  valid (Choice _ xs) = Set.valid xs
+
+instance SetLike (Choice 'AtleastOne) where
+  toSet (Choice x xs) = Set.singleton x <> xs
+  smap f (Choice x xs) = Choice (f x)         (Set.map f xs)
+  valid (Choice _ xs)  = Set.valid xs
+
+instance SetLike (Choice 'Many) where
+  toSet (Choice x xs) = toSet x <> xs
+  smap f (Choice x xs) = Choice (Set.map f x) (Set.map f xs)
+  valid (Choice x xs)  = Set.valid x && Set.valid xs
+
+
+ftoSet :: (Ord a, Foldable g) => g a -> Set a
+ftoSet = Set.fromList . F.toList
+
+
+class SetLike (f p) => Selection f (p :: Pick) where
+  select       :: Ord a => f p a -> Selected p a -> f p a
+  select'      :: Ord a => f p a -> a -> f p a
+  unselected   :: Ord a => f p a -> Set a
+  selected     :: Ord a => f p a -> Selected p a
+  withOptions  :: (Foldable g, Ord a) => Selected p a -> g a -> f p a
+  withOptions' :: (Foldable g, Ord a) => a -> g a -> f p a
+
+instance Selection Choice 'One where
+  select (Choice w xs) y = Choice y (toSet w <> toSet y <> xs)
+  select' c = select c . Just
+  unselected (Choice x xs) = maybe xs (`Set.delete` xs) x
+  selected = _selected
+  withOptions x (ftoSet -> xs) = Choice x $ maybe xs (`Set.insert` xs) x
+  withOptions' = withOptions . Just
+
+instance Selection Choice 'AtleastOne where
+  select (Choice _ xs) y = Choice y (Set.insert y xs)
+  select' = select
+  unselected (Choice x xs) = Set.delete x xs
+  selected = _selected
+  withOptions x (ftoSet -> xs) = Choice x (Set.insert x xs)
+  withOptions' = withOptions
+
+instance Selection Choice 'Many where
+  select (Choice x xs) y = Choice (y <> x) (y <> xs)
+  select' c = select c . Set.singleton
+  unselected (Choice x xs) = Set.difference xs x
+  selected = _selected
+  withOptions x (ftoSet -> xs) = Choice x (x <> xs)
+  withOptions' = withOptions . Set.singleton
+
+
+class Selection f p => Deselection f (p :: Pick) where
+  noselection :: (Foldable g, Ord a) => g a -> f p a
+  deselect    :: Ord a => f p a -> f p a
+
+instance Deselection Choice 'One where
+  noselection = Choice Nothing . Set.fromList . F.toList
+  deselect = flip select Nothing
+
+instance Deselection Choice 'Many where
+  noselection = Choice mempty . Set.fromList . F.toList
+  deselect (Choice ys xs) = Choice mempty (ys <> xs)
+
+
+next, nextLoop, prev, prevLoop :: (Selection f 'AtleastOne, Ord a) => f 'AtleastOne a -> f 'AtleastOne a
+next     xs = maybe xs                     (select xs) . Set.lookupGT (selected xs) $ toSet xs
+nextLoop xs = maybe (unsafeSelectFirst xs) (select xs) . Set.lookupGT (selected xs) $ toSet xs
+prev     xs = maybe xs                     (select xs) . Set.lookupLT (selected xs) $ toSet xs
+prevLoop xs = maybe (unsafeSelectLast xs)  (select xs) . Set.lookupLT (selected xs) $ toSet xs
+
+
+selectAll :: Choice 'Many a -> Choice 'Many a
+selectAll (Choice _ xs) = Choice xs xs
+
+
+unsafeSelectFirst :: (Selection f p, Ord a) => f p a -> f p a
+unsafeSelectFirst c = select' c . Set.findMin $ toSet c
+
+
+unsafeSelectLast :: (Selection f p, Ord a) => f p a -> f p a
+unsafeSelectLast c = select' c . Set.findMax $ toSet c
+
+
+selectFirst :: (Selection f p, Ord a) => f p a -> Maybe (f p a)
+selectFirst c = fmap (select' c) . Set.lookupMin $ toSet c
+
+
+selectLast :: (Selection f p, Ord a) => f p a -> Maybe (f p a)
+selectLast c = fmap (select' c) . Set.lookupMax $ toSet c
+
+
+fullset :: (Bounded a, Enum a) => Set a
+fullset = Set.fromDistinctAscList [minBound..maxBound]
+
+
+fullOptions :: (Deselection f p, Bounded a, Enum a, Ord a) => f p a
+fullOptions = noselection fullset
+
+
+fullOptionsMin :: (Selection f p, Bounded a, Enum a, Ord a) => f p a
+fullOptionsMin = fromNonEmpty $ minBound NE.:| [succ minBound..maxBound]
+
+
+fullOptionsMax :: (Selection f p, Bounded a, Enum a, Ord a) => f p a
+fullOptionsMax = fromNonEmpty $ maxBound NE.:| [minBound..pred maxBound]
+
+
+fromNonEmpty :: (Selection f p, Ord a) => NE.NonEmpty a -> f p a
+fromNonEmpty xs' = let (x NE.:| xs) = NE.sort xs' in x `withOptions'` Set.fromList xs
+
+
+selectWhen :: (SetLike g, Selection f 'Many, Ord a) => (a -> Bool) -> g a -> Maybe (f 'Many a)
+selectWhen p xs' = if sub == Set.empty then Nothing else Just (sub `withOptions` xs)
+  where sub = Set.filter p xs
+        xs = toSet xs'
+
+
+selectFirstWhen :: (SetLike g, Deselection f p, Ord a) => (a -> Bool) -> g a -> Maybe (f p a)
+selectFirstWhen p xs = if sub == Set.empty then Nothing else selectFirst $ noselection sub
+  where sub = Set.filter p $ toSet xs
+
+
+selectLastWhen :: (SetLike g, Deselection f p, Ord a) => (a -> Bool) -> g a -> Maybe (f p a)
+selectLastWhen p xs = if sub == Set.empty then Nothing else selectLast $ noselection sub
+  where sub = Set.filter p $ toSet xs
+
+
+toList :: (SetLike f, Ord a) => f a -> [a]
+toList = Set.toList . toSet
+
+
+singleton :: (Selection f p, Ord a) => a -> f p a
+singleton x = x `withOptions'` Set.singleton x
+
+
+before :: (Selection f 'AtleastOne, Ord a) => f 'AtleastOne a -> Set a
+before xs = Set.filter (< selected xs) $ toSet xs
+
+
+unsafeSelectAt :: (SetLike g, Selection f 'AtleastOne, Ord a) => Int -> g a -> f 'AtleastOne a
+unsafeSelectAt i xs' = let xs = toSet xs' in Set.elemAt i xs `withOptions'` xs
+
+
+getIndex :: (Selection f 'AtleastOne, Ord a) => f 'AtleastOne a -> Int
+getIndex xs = findIndex (selected xs) $ toSet xs
+
+
+after :: (Selection f 'AtleastOne, Ord a) => f 'AtleastOne a -> Set a
+after xs = Set.filter (> selected xs) $ toSet xs
+
+
+size :: (SetLike g, Ord a) => g a -> Int
+size = Set.size . toSet
+
+
+insert :: (Selection f p, Ord a) => a -> f p a -> f p a
+insert y xs = selected xs `withOptions` Set.insert y (toSet xs)
+
+
+delete :: (Compactable (f p), Ord a) => a -> f p a -> f p a
+delete y = Control.Compactable.filter (/= y)
+
+
+addSelection :: (Selection f 'Many, Ord a) => a -> f 'Many a -> f 'Many a
+addSelection y c = select c $ Set.singleton y
+
+
+deselectMany :: (Compactable (f p), Ord a) => Set a -> f p a -> f p a
+deselectMany y = Control.Compactable.filter (`Set.member` y)
+
+
+data ConsideredChoice p a = ConsideredChoice
+  { _consideration :: Considered p a
+  , _choice        :: Choice p a
+  }
+
+
+deriving instance (Show (Selected p a), Show (Considered p a), Show a)        => Show (ConsideredChoice p a)
+deriving instance (Read (Selected p a), Read (Considered p a), Read a, Ord a) => Read (ConsideredChoice p a)
+deriving instance (Eq   (Selected p a), Eq   (Considered p a), Eq a)          => Eq   (ConsideredChoice p a)
+deriving instance (Ord  (Selected p a), Ord  (Considered p a), Ord a)         => Ord  (ConsideredChoice p a)
+deriving instance Generic (ConsideredChoice p a)
+instance (FromJSON a, FromJSON (Considered p a), FromJSON (Selected p a), Ord a) => FromJSON (ConsideredChoice p a)
+instance (ToJSON a,   ToJSON (Considered p a),   ToJSON (Selected p a))          => ToJSON   (ConsideredChoice p a)
+
+instance (Compactable (Choice p), Compactable (Considered p)) => Compactable (ConsideredChoice p) where
+  compact (ConsideredChoice x xs) = ConsideredChoice (compact x) (compact xs)
+  separate (ConsideredChoice x xs) = let (l,r) = separate xs; (l',r') = separate x in (ConsideredChoice l' l, ConsideredChoice r' r)
+  filter p (ConsideredChoice x xs) = ConsideredChoice (Control.Compactable.filter p x) $ Control.Compactable.filter p xs
+  partition p (ConsideredChoice x xs) = let (l, r) = Control.Compactable.partition p xs; (l',r') = Control.Compactable.partition p x in (ConsideredChoice l' l, ConsideredChoice r' r)
+
+instance (Ord a, Considered p ~ Maybe, Semigroup (Choice p a))
+    => Semigroup (ConsideredChoice p a) where
+  ConsideredChoice c cc <> ConsideredChoice c' cc' = ConsideredChoice (c <|> c') (cc <> cc')
+
+instance {-# OVERLAPPING #-} (Ord a) => Semigroup (ConsideredChoice 'Many a) where
+  ConsideredChoice c cc <> ConsideredChoice c' cc' = ConsideredChoice (c <> c') (cc <> cc')
+
+
+type family Considered (p :: Pick) :: Type -> Type where
+  Considered 'One        = Maybe
+  Considered 'AtleastOne = Maybe
+  Considered 'Many       = Set
+
+
+instance (Considered p ~ Maybe, SetLike (Choice p)) => SetLike (ConsideredChoice p) where
+  toSet (ConsideredChoice x xs) = toSet xs <> case x of
+    Just y -> Set.singleton y
+    _      -> mempty
+  smap f (ConsideredChoice x xs) = ConsideredChoice (f <$> x) (smap f xs)
+  valid (ConsideredChoice _ xs) = Shpadoinkle.Widgets.Types.Choice.valid xs
+
+
+instance SetLike (ConsideredChoice 'Many) where
+  toSet (ConsideredChoice ys xs) = ys <> toSet xs
+  smap f (ConsideredChoice ys xs) = ConsideredChoice (smap f ys) (smap f xs)
+  valid (ConsideredChoice ys xs) = Set.valid ys && Shpadoinkle.Widgets.Types.Choice.valid xs
+
+
+instance (Considered p ~ Maybe, SetLike (ConsideredChoice p), Selection Choice p)
+    => Selection ConsideredChoice p where
+  select  (ConsideredChoice c xs) x = ConsideredChoice c (select xs x)
+  select' (ConsideredChoice c xs) x = ConsideredChoice c (select' xs x)
+  unselected        = unselected . _choice
+  selected          = selected . _choice
+  withOptions  x xs = ConsideredChoice Nothing (x `withOptions` xs)
+  withOptions' x xs = ConsideredChoice Nothing (x `withOptions'` xs)
+
+
+instance SetLike (ConsideredChoice 'Many) => Selection ConsideredChoice 'Many where
+  select  (ConsideredChoice c xs) x = ConsideredChoice c (select xs x)
+  select' (ConsideredChoice c xs) x = ConsideredChoice c (select' xs x)
+  unselected        = unselected . _choice
+  selected          = selected . _choice
+  withOptions  x xs = ConsideredChoice mempty (x `withOptions` xs)
+  withOptions' x xs = ConsideredChoice mempty (x `withOptions'` xs)
+
+
+instance Selection ConsideredChoice 'One => Deselection ConsideredChoice 'One where
+  noselection = ConsideredChoice Nothing . noselection
+  deselect (ConsideredChoice c xs) = ConsideredChoice c $ deselect (select xs c)
+
+instance Selection ConsideredChoice 'Many => Deselection ConsideredChoice 'Many where
+  noselection = ConsideredChoice mempty . noselection
+  deselect (ConsideredChoice c xs) = ConsideredChoice c $ deselect (select xs c)
+
+
+class Selection f p => Consideration f (p :: Pick) where
+  consider   :: Ord a => Considered p a -> f p a -> f p a
+  consider'  :: Ord a => a -> f p a -> f p a
+  choose     :: Ord a => f p a -> f p a
+  choice     :: Ord a => f p a -> Choice p a
+  considered :: Ord a => f p a -> Considered p a
+  shrug      :: Ord a => f p a -> f p a
+
+instance Consideration ConsideredChoice 'One where
+  consider x = ConsideredChoice x . maybe id Shpadoinkle.Widgets.Types.Choice.insert x . _choice
+  consider' = consider @ConsideredChoice @'One . Just
+  choose (ConsideredChoice x xs) = ConsideredChoice Nothing $ select xs x
+  choice = _choice
+  considered = _consideration
+  shrug (ConsideredChoice _ xs) = ConsideredChoice Nothing xs
+
+instance Consideration ConsideredChoice 'AtleastOne where
+  consider x = ConsideredChoice x . maybe id Shpadoinkle.Widgets.Types.Choice.insert x . _choice
+  consider' = consider @ConsideredChoice @'AtleastOne . Just
+  choose (ConsideredChoice x xs) = ConsideredChoice Nothing . fromMaybe xs $ select xs <$> x
+  choice = _choice
+  considered = _consideration
+  shrug (ConsideredChoice _ xs) = ConsideredChoice Nothing xs
+
+instance Selection ConsideredChoice 'Many => Consideration ConsideredChoice 'Many where
+  consider xs (ConsideredChoice _ (Choice y ys)) = ConsideredChoice xs (Choice y (xs <> ys))
+  consider' = consider @ConsideredChoice @'Many . Set.singleton
+  choose (ConsideredChoice s xs) = ConsideredChoice Set.empty $ select xs s
+  choice = _choice
+  considered = _consideration
+  shrug (ConsideredChoice _ xs) = ConsideredChoice mempty xs
+
+
+unsafeConsiderFirst :: (Consideration f p, Ord a) => f p a -> f p a
+unsafeConsiderFirst c = Set.findMin (toSet c) `consider'` c
+
+
+unsafeConsiderLast :: (Consideration f p, Ord a) => f p a -> f p a
+unsafeConsiderLast c = Set.findMax (toSet c) `consider'` c
+
+
+considerNext, considerPrev :: (Considered p a ~ Maybe a, Consideration f p, Ord a) => f p a -> f p a
+considerNext c = maybe (unsafeConsiderFirst c) (`consider'` c) $ considered c >>= (\x -> Set.lookupGT x $ toSet c)
+considerPrev c = maybe (unsafeConsiderLast c)  (`consider'` c) $ considered c >>= (\x -> Set.lookupLT x $ toSet c)
diff --git a/Shpadoinkle/Widgets/Types/Core.hs b/Shpadoinkle/Widgets/Types/Core.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Types/Core.hs
@@ -0,0 +1,77 @@
+{-# LANGUAGE AllowAmbiguousTypes  #-}
+{-# LANGUAGE ConstraintKinds      #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DefaultSignatures    #-}
+{-# LANGUAGE DeriveAnyClass       #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE InstanceSigs         #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+
+module Shpadoinkle.Widgets.Types.Core where
+
+
+import           Data.Aeson
+import           Data.Text
+import           GHC.Generics
+
+import           Shpadoinkle
+
+
+data Hygiene = Clean | Dirty
+  deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic, ToJSON, FromJSON)
+
+
+instance Semigroup Hygiene where
+  Clean <> Clean = Clean
+  _ <> _ = Dirty
+
+
+instance Monoid Hygiene where
+  mempty = Clean
+
+
+data Ability = Enabled | Disabled
+  deriving (Eq, Ord, Show, Enum, Bounded)
+
+
+toBool :: Ability -> Bool
+toBool Enabled  = True
+toBool Disabled = False
+
+
+fromBool :: Bool -> Ability
+fromBool True  = Enabled
+fromBool False = Disabled
+
+
+class Humanize a where
+  humanize :: a -> Text
+  default humanize :: Show a => a -> Text
+  humanize = pack . show
+  {-# INLINE humanize #-}
+
+
+instance Humanize Text where
+  humanize = id
+  {-# INLINE humanize #-}
+
+
+instance Humanize String where
+  humanize = pack
+  {-# INLINE humanize #-}
+
+
+class Present a where
+  present :: a -> [Html m b]
+  default present :: Humanize a => a -> [Html m b]
+  present = pure . text . humanize
+  {-# INLINE present #-}
+
+
+instance {-# OVERLAPPABLE #-} Humanize a => Present a
diff --git a/Shpadoinkle/Widgets/Types/Form.hs b/Shpadoinkle/Widgets/Types/Form.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Types/Form.hs
@@ -0,0 +1,178 @@
+{-# LANGUAGE AllowAmbiguousTypes        #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DefaultSignatures          #-}
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveFoldable             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE PartialTypeSignatures      #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TypeOperators              #-}
+
+
+module Shpadoinkle.Widgets.Types.Form
+  (module Shpadoinkle.Widgets.Types.Form
+  ) where
+
+
+import           Control.Applicative
+import           Control.Monad.Except
+import           Data.Aeson
+import           Data.Kind
+import           Data.String
+import           Data.Text                      hiding (empty)
+import           GHC.Generics
+
+import           Shpadoinkle.Widgets.Types.Core
+
+
+data Input a = Input
+  { _hygiene :: Hygiene
+  , _value   :: a
+  } deriving (Eq, Ord, Show, Read, Functor, Traversable, Foldable, Generic, ToJSON, FromJSON)
+
+
+class Control g where
+  type Val g a :: Type
+  type Val g a = a
+  hygiene :: Applicative f => (Hygiene -> f Hygiene) -> g a -> f (g a)
+  value   :: (Applicative f, Ord a) => (Val g a -> f (Val g a)) -> g a -> f (g a)
+
+
+getValue :: (Ord a, Monoid (Val g a), Control g) => g a -> Val g a
+getValue = getConst . value Const
+
+
+getHygiene :: Control g => g a -> Hygiene
+getHygiene = getConst . hygiene Const
+
+
+instance Control Input where
+  hygiene f i = (\h -> i { _hygiene = h }) <$> f (_hygiene i)
+  value   f i = (\a -> i { _value   = a }) <$> f (_value i)
+
+
+instance Applicative Input where
+  Input h fa <*> Input h' a = Input (h <> h') (fa a)
+  pure = Input mempty
+
+
+instance Monad Input where
+  Input h a >>= f = let Input h' a' = f a in Input (h <> h') a'
+
+
+instance Semigroup a => Semigroup (Input a) where
+  Input h a <> Input h' a' = Input (h <> h') (a <> a')
+
+
+instance Monoid a => Monoid (Input a) where
+  mempty = Input mempty mempty
+
+
+newtype Placeholder = Placeholder { unPlaceholder :: Text }
+  deriving newtype (Eq, Ord, Show, Read, IsString, Semigroup, Monoid, ToJSON, FromJSON)
+  deriving stock Generic
+
+
+data Validated e a = Validated a | Invalid e [e]
+  deriving (Eq, Ord, Show, Read, Generic, ToJSON, FromJSON, Functor, Foldable, Traversable)
+
+instance Semigroup (Validated e a) where
+  Validated a <> Validated _ = Validated a
+  Validated _ <> x = x
+  x <> Validated _ = x
+  Invalid x xs <> Invalid y ys = Invalid x (xs <> (y:ys))
+
+
+instance Applicative (Validated e) where
+  Validated f <*> Validated a = Validated (f a)
+  Invalid x xs <*> _ = Invalid x xs
+  _ <*> Invalid x xs = Invalid x xs
+  pure = Validated
+
+
+instance Monad (Validated e) where
+  Validated a >>= f = f a
+  Invalid x xs >>= _ = Invalid x xs
+
+
+instance MonadError e (Validated e) where
+  throwError e = Invalid e []
+  catchError (Invalid x _) f = f x
+  catchError v _             = v
+
+
+data Status = Edit | Rules | Valid | Errors
+
+
+type family Field (s :: Status) (e :: Type) (f :: Type -> Type) (x :: Type) :: Type where
+  Field 'Valid    _ _ a = a
+  Field 'Errors   e _ a = Validated e a
+  Field 'Edit     _ f a = f a
+  Field 'Rules    e f a = Val f a -> Validated e a
+
+
+class ValidateG rules edit errs where
+  validateg :: rules a -> edit a -> errs a
+instance ValidateG U1 U1 U1 where
+  validateg _ _ = U1
+instance (ValidateG a b c, ValidateG d e f)
+  => ValidateG (a :*: d) (b :*: e) (c :*: f) where
+  validateg (a :*: b) (c :*: d) = validateg a c :*: validateg b d
+instance (ValidateG a b c, ValidateG d e f, Alternative (c :+: f))
+  => ValidateG (a :+: d) (b :+: e) (c :+: f) where
+  validateg (L1 a) (L1 b) = L1 $ validateg a b
+  validateg (R1 a) (R1 b) = R1 $ validateg a b
+  validateg _ _           = empty
+instance ValidateG a b c
+  => ValidateG (M1 i x a) (M1 i' x' b) (M1 i'' x'' c) where
+  validateg (M1 a) (M1 b) = M1 $ validateg a b
+instance (Control c, Monoid v, Val c a ~ v, Ord a)
+  => ValidateG (K1 i (v -> b)) (K1 i' (c a)) (K1 i'' b) where
+  validateg (K1 f) (K1 x) = K1 (f $ getValue x)
+
+
+class ValidG err valid where
+  validg :: err a -> Maybe (valid a)
+instance ValidG U1 U1 where
+  validg _ = Just U1
+instance (ValidG a c, ValidG b d) => ValidG (a :*: b) (c :*: d) where
+  validg (a :*: b) = liftA2 (:*:) (validg a) (validg b)
+instance (ValidG a c, ValidG b d) => ValidG (a :+: b) (c :+: d) where
+  validg (L1 a) = L1 <$> validg a
+  validg (R1 a) = R1 <$> validg a
+instance (ValidG a b) => ValidG (M1 i c a) (M1 i' c' b) where
+  validg (M1 a) = M1 <$> validg a
+instance ValidG (K1 i (Validated t a)) (K1 i' a) where
+  validg (K1 (Validated a)) = Just $ K1 a
+  validg _                  = Nothing
+
+
+class Validate (f :: Status -> Type) where
+  validate :: f 'Edit -> f 'Errors
+  default validate
+    :: Generic (f 'Edit)
+    => Generic (f 'Rules)
+    => Generic (f 'Errors)
+    => ValidateG (Rep (f 'Rules)) (Rep (f 'Edit)) (Rep (f 'Errors))
+    => f 'Edit -> f 'Errors
+  validate edit = to $ validateg (from (rules @ f)) (from edit)
+
+  getValid :: f 'Errors -> Maybe (f 'Valid)
+  default getValid
+    :: Generic (f 'Errors)
+    => Generic (f 'Valid)
+    => ValidG (Rep (f 'Errors)) (Rep (f 'Valid))
+    => f 'Errors -> Maybe (f 'Valid)
+  getValid = fmap to . validg . from
+
+  rules :: f 'Rules
diff --git a/Shpadoinkle/Widgets/Types/Physical.hs b/Shpadoinkle/Widgets/Types/Physical.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Types/Physical.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric  #-}
+{-# LANGUAGE LambdaCase     #-}
+
+
+module Shpadoinkle.Widgets.Types.Physical where
+
+
+import           Data.Aeson
+import           GHC.Generics
+
+import           Shpadoinkle.Widgets.Types.Core
+
+
+data Toggle = Closed Hygiene | Open
+  deriving (Eq, Ord, Show, Read, Generic, ToJSON, FromJSON)
+
+
+togHygiene :: Toggle -> Hygiene
+togHygiene = \case
+  Closed x -> x
+  _ -> Dirty
+
+
+instance Enum Toggle where
+  fromEnum (Closed Clean) = 0
+  fromEnum Open           = 1
+  fromEnum (Closed Dirty) = 2
+  toEnum 0 = Closed Clean
+  toEnum 1 = Open
+  toEnum 2 = Closed Dirty
+  toEnum _ = error "Not a valid Toggle"
+
+
+instance Bounded Toggle where
+  minBound = Closed Clean
+  maxBound = Closed Dirty
+
+
+instance Semigroup Toggle where
+  Closed x <> Closed y = Closed (x <> y)
+  Closed Clean <> x = x
+  x <> Closed Clean = x
+  Closed Dirty <> _ = Closed Dirty
+  _ <> Closed Dirty = Closed Dirty
+  _ <> _ = Open
+
+
+instance Monoid Toggle where
+  mempty = Closed Clean
+
+
+class IsToggle a where
+  close    :: a -> a
+  toggle   :: a -> a
+  open     :: a -> a
+
+
+instance IsToggle Toggle where
+
+  close = \case
+    Open -> Closed Dirty
+    t    -> t
+
+  toggle = \case
+    Open     -> Closed Dirty
+    Closed _ -> Open
+
+  open = const Open
+
+
+data Visbility = Visible | Hidden
+  deriving (Eq, Ord, Show, Enum, Bounded, Generic)
diff --git a/Shpadoinkle/Widgets/Types/Remote.hs b/Shpadoinkle/Widgets/Types/Remote.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Types/Remote.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+
+module Shpadoinkle.Widgets.Types.Remote where
+
+
+import           GHC.Generics
+
+
+data Remote e a
+  = Success a
+  | Failure e
+  | Loading
+  | NotAsked
+  deriving (Eq, Ord, Show, Read, Generic, Functor)
+
+
+instance Applicative (Remote e) where
+  pure = Success
+  Success f <*> Success x = Success (f x)
+  Failure e <*> _ = Failure e
+  _ <*> Failure e = Failure e
+  Loading <*> _   = Loading
+  _ <*> Loading   = Loading
+  NotAsked <*> _  = NotAsked
+  _ <*> NotAsked  = NotAsked
+
+
+instance Monad (Remote e) where
+  Success a >>= f = f a
+  Failure e >>= _ = Failure e
+  NotAsked  >>= _ = NotAsked
+  Loading   >>= _ = Loading
diff --git a/Shpadoinkle/Widgets/Types/Search.hs b/Shpadoinkle/Widgets/Types/Search.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Types/Search.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE DeriveAnyClass             #-}
+{-# LANGUAGE DeriveFunctor              #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE ViewPatterns               #-}
+
+
+module Shpadoinkle.Widgets.Types.Search where
+
+
+import           Data.Aeson
+import           Data.Foldable     as F
+import           Data.List         (sort)
+import           Data.Maybe        (mapMaybe)
+import           Data.String
+import           Data.Text
+import           GHC.Generics
+import           Text.EditDistance
+
+
+newtype Search = Search { unSearch :: Text }
+  deriving newtype (Eq, Ord, Show, Read, IsString, Semigroup, Monoid, ToJSON, FromJSON)
+  deriving stock Generic
+
+
+data Levenshtiened a = Levenshtiened { _distance :: !Int, _unLevenshtiened :: a } deriving Eq
+instance Eq       a => Ord      (Levenshtiened a) where
+  compare (Levenshtiened x _) (Levenshtiened y _) = compare x y
+
+
+mkLevenshtiened :: Text -> Search -> a -> Levenshtiened a
+mkLevenshtiened  t (Search s) x =
+  Levenshtiened (levenshteinDistance defaultEditCosts (prep s) (prep t)) x
+  where prep = unpack . strip
+
+
+forgivingly :: Search -> Text -> Bool
+forgivingly (Search (strip -> "")) _ = True
+forgivingly (Search s) haystack = Prelude.all test . splitOn " " $ strip s
+  where test ""     = False
+        test needle = forgive needle `isInfixOf` forgive haystack
+        forgive = toLower . strip
+
+
+concatFuzzy :: [a -> Text] -> a -> Text
+concatFuzzy = F.foldl' (\f g a -> f a <> " " <> g a) (const "")
+
+
+fuzzySearch :: Ord a => [a -> Text] -> Search -> [a] -> [a]
+fuzzySearch toChunks s = fmap _unLevenshtiened . sort .
+  mapMaybe (\x -> let hay = concatFuzzy toChunks x
+                  in if forgivingly s hay
+                     then Just $ mkLevenshtiened hay s x
+                     else Nothing
+           )
diff --git a/Shpadoinkle/Widgets/Validation.hs b/Shpadoinkle/Widgets/Validation.hs
new file mode 100644
--- /dev/null
+++ b/Shpadoinkle/Widgets/Validation.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns      #-}
+
+
+module Shpadoinkle.Widgets.Validation where
+
+
+import           Control.Monad.Except
+import           Data.Text
+import           Data.Text.Encoding
+import           Shpadoinkle.Widgets.Types.Form
+import           Text.Email.Validate
+
+
+nonMEmpty :: (Monoid a, Eq a) => a -> Validated Text a
+nonMEmpty x = if x == mempty then throwError "Cannot be empty" else pure x
+
+
+nonMEmpty' :: (Monoid a, Eq a) => Maybe a -> Validated Text a
+nonMEmpty' x = case x of
+  Just y  -> nonMEmpty y
+  Nothing -> throwError "Cannot be empty"
+
+
+nonZero :: (Num n, Eq n) => n -> Validated Text n
+nonZero n = if n == 0 then throwError "Cannot be zero" else pure n
+
+
+positive :: (Num n, Ord n) => n -> Validated Text n
+positive n = if n < 0 then throwError "Must be positive" else pure n
+
+
+natural :: (Num n, Ord n) => n -> Validated Text n
+natural = nonZero <> positive
+
+
+negative :: (Num n, Ord n) => n -> Validated Text n
+negative n = if n > 0 then throwError "Must be negative" else pure n
+
+
+between :: (Ord n, Show n) => (n,n) -> n -> Validated Text n
+between (sortTup -> (low, high)) n
+  | n < low   = throwError $ "Must be greater than " <> pack (show low)
+  | n > high  = throwError $ "Must be less than "    <> pack (show high)
+  | otherwise = pure n
+
+
+sortTup :: Ord n => (n,n) -> (n,n)
+sortTup (x,y) = if x < y then (x,y) else (y,x)
+
+
+email :: Text -> Validated Text Text
+email i = if isValid (encodeUtf8 i) then pure i else throwError "Not a valid email"
diff --git a/tests/Test.hs b/tests/Test.hs
new file mode 100644
--- /dev/null
+++ b/tests/Test.hs
@@ -0,0 +1,205 @@
+{-# LANGUAGE AllowAmbiguousTypes  #-}
+{-# LANGUAGE ConstraintKinds      #-}
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE DeriveGeneric        #-}
+{-# LANGUAGE FlexibleContexts     #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE KindSignatures       #-}
+{-# LANGUAGE RankNTypes           #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+
+module Main where
+
+
+import           Data.Kind
+import           Data.Set                          as Set
+import           GHC.Generics
+
+import           Test.Hspec
+import           Test.QuickCheck
+
+
+import           Shpadoinkle.Widgets.Form.Dropdown
+import           Shpadoinkle.Widgets.Types
+
+
+data Foo = Bar | Baz | Qux | Nerp
+  deriving (Eq, Ord, Show, Enum, Bounded, Generic)
+
+
+instance Semigroup Foo where (<>) = min
+instance Monoid Foo where mempty = maxBound
+
+
+instance Arbitrary Foo where
+  arbitrary = arbitraryBoundedEnum
+
+instance (Ord a, Arbitrary a, Arbitrary (Selected p a)) => Arbitrary (Choice p a) where
+  arbitrary = Choice <$> arbitrary <*> arbitrary
+
+instance (Ord a, Arbitrary a, Arbitrary (Selected p a), Arbitrary (Considered p a)) => Arbitrary (ConsideredChoice p a) where
+  arbitrary = ConsideredChoice <$> arbitrary <*> arbitrary
+
+instance (Ord a, Arbitrary a, Arbitrary (ConsideredChoice p a)) => Arbitrary (Dropdown p a) where
+  arbitrary = Dropdown <$> arbitrary <*> arbitrary
+
+instance Arbitrary Toggle where
+  arbitrary = arbitraryBoundedEnum
+
+
+type TestConstrant f p =
+  ( Arbitrary (f p Foo)
+  , Selection f p
+  , Show (f p Foo)
+  , Eq (f p Foo)
+  )
+
+
+type TestConstrants f =
+  ( TestConstrant f 'One
+  , TestConstrant f 'AtleastOne
+  , TestConstrant f 'Many
+  )
+
+
+selectionProps :: forall (f :: Pick -> Type -> Type). TestConstrants f => Spec
+selectionProps = do
+
+  describe "selected is an option" $ do
+
+    it "One"        . property $ \(c :: f 'One Foo) ->
+      toSet (selected c) `isSubsetOf` toSet c
+    it "AtleastOne" . property $ \(c :: f 'AtleastOne Foo) ->
+      Set.singleton (selected c) `isSubsetOf` toSet c
+    it "Many"       . property $ \(c :: f 'Many Foo) ->
+      toSet (selected c) `isSubsetOf` toSet c
+
+
+  describe "if we select something it's an option" $ do
+
+    it "One'"        . property $ \(c :: f 'One Foo) x ->
+      x `member` toSet (select' c x)
+    it "AtleastOne'" . property $ \(c :: f 'AtleastOne Foo) x ->
+      x `member` toSet (select' c x)
+    it "Many'"       . property $ \(c :: f 'Many Foo) x ->
+      x `member` toSet (select' c x)
+
+
+  describe "selected and unselected are exclusive" $ do
+
+    it "One"        . property $ \(c :: f 'One Foo) ->
+      toSet (selected c) `disjoint` unselected c
+    it "AtleastOne" . property $ \(c :: f 'AtleastOne Foo) ->
+      Set.singleton (selected c) `disjoint` unselected c
+    it "Many"       . property $ \(c :: f 'Many Foo) ->
+      toSet (selected c) `disjoint` unselected c
+
+
+  describe "idempotence select" $ do
+
+    it "One"        . property $ \(c :: f 'One Foo) x ->
+      select' (select' c x) x == select' c x
+    it "AtleastOne" . property $ \(c :: f 'AtleastOne Foo) x ->
+      select' (select' c x) x == select' c x
+    it "Many"       . property $ \(c :: f 'Many Foo) x ->
+      select' (select' c x) x == select' c x
+
+
+  describe "select selected identity" $ do
+
+    it "One"        . property $ \x ->
+      selected (x `withOptions` Set.empty :: f 'One Foo) == x
+    it "AtleastOne" . property $ \x ->
+      selected (x `withOptions` Set.empty :: f 'AtleastOne Foo) == x
+    it "Many"       . property $ \x ->
+      selected (x `withOptions` Set.empty :: f 'Many Foo) == x
+
+
+  describe "unselected withOptions identity" $ do
+
+    it "One"        . property $ \x ->
+      unselected (x `withOptions` Set.empty :: f 'One Foo) == mempty
+    it "AtleastOne" . property $ \x ->
+      unselected (x `withOptions` Set.empty :: f 'AtleastOne Foo) == mempty
+    it "Many"       . property $ \x ->
+      unselected (x `withOptions` Set.empty :: f 'Many Foo) == mempty
+
+
+  describe "selected is not unselected" $ do
+
+    it "One" . property $ \(c :: f 'One Foo) x ->
+      not $ x `member` unselected (select' c x)
+    it "AtleastOne" . property $ \(c :: f 'AtleastOne Foo) x ->
+      not $ x `member` unselected (select' c x)
+    it "Many" . property $ \(c :: f 'Many Foo) x ->
+      not $ x `member` unselected (select' c x)
+
+
+deselectionPropsOne :: forall (f :: Pick -> Type -> Type). TestConstrants f => Deselection f 'One => Spec
+deselectionPropsOne = describe "One" $ do
+
+    it "idempotence deselect" . property $ \(c :: f 'One Foo) ->
+        deselect (deselect c) == deselect c
+
+    it "deselect select selected identity" . property $ \(c :: f 'One Foo) x ->
+        selected (select (deselect c) x) == x
+
+    it "selected deselect annihliation" . property $ \(c :: f 'One Foo) ->
+        selected (deselect c) == mempty
+
+    it "deselect keeps" . property $ \(c :: f 'One Foo) x ->
+        toSet x `isSubsetOf` toSet (deselect (select c x))
+
+    it "unselected passes through deselect keeps" . property $ \(c :: f 'One Foo) x ->
+        toSet x `isSubsetOf` unselected (deselect (select c x))
+
+    it "deselect unselected is full set" . property $ \(c :: f 'One Foo) ->
+        unselected (deselect c) == toSet c
+
+
+deselectionPropsMany :: forall (f :: Pick -> Type -> Type). TestConstrants f => Deselection f 'Many => Spec
+deselectionPropsMany = describe "Many" $ do
+
+    it "idempotence deselect" . property $ \(c :: f 'Many Foo) ->
+        deselect (deselect c) == deselect c
+
+    it "deselect select selected identity" . property $ \(c :: f 'Many Foo) x ->
+        selected (select (deselect c) x) == x
+
+    it "selected deselect annihliation" . property $ \(c :: f 'Many Foo) ->
+        selected (deselect c) == mempty
+
+    it "deselect keeps" . property $ \(c :: f 'Many Foo) x ->
+        toSet x `isSubsetOf` toSet (deselect (select c x))
+
+    it "unselected passes through deselect keeps" . property $ \(c :: f 'Many Foo) x ->
+        toSet x `isSubsetOf` unselected (deselect (select c x))
+
+    it "deselect unselected is full set" . property $ \(c :: f 'Many Foo) ->
+        unselected (deselect c) == toSet c
+
+
+main :: IO ()
+main = hspec $ do
+  it "foooid" . property $ \(x :: Foo) y z ->
+    x <> mempty == x && x == mempty <> x && (x <> y) <> z == x <> (y <> z)
+
+  describe "Choice" $ do
+    selectionProps       @Choice
+    deselectionPropsOne  @Choice
+    deselectionPropsMany @Choice
+
+
+  describe "ConsideredChoice" $ do
+    selectionProps       @ConsideredChoice
+    deselectionPropsOne  @ConsideredChoice
+    deselectionPropsMany @ConsideredChoice
+
+
+  describe "Dropdown" $ do
+    selectionProps      @Dropdown
+    deselectionPropsOne @Dropdown