packages feed

nano-ui-form (empty) → 0.1.0.0

raw patch · 17 files changed

+1776/−0 lines, 17 filesdep +basedep +containersdep +ditto

Dependencies added: base, containers, ditto, effectful-core, hashable, nano-ui, nano-ui-form, nano-ui-sdl, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,10 @@+# Changelog++## 0.1.0.0++First release.++- Applicative forms on ditto whose inputs are nano-ui widgets, with+  validation errors shown under each field.+- `nanoFormSubmit`, `nanoFormLive`, `nanoFormEx` and `runNanoForm` run a form+  in a view.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2026 goolord++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,45 @@+# nano-ui-form++Forms for [nano-ui](https://github.com/goolord/nano-ui), built on+[ditto](https://hackage.haskell.org/package/ditto).++A form is an applicative value. Each input draws a nano-ui widget and parses+its value; validators attach errors that appear under the field.++```haskell+{-# LANGUAGE OverloadedStrings #-}++import Data.Text (Text)+import NanoUI (NanoUI, label)+import NanoUI.Form hiding (label)++data Signup = Signup Text Text++signup :: Form Text Signup+signup =+  Signup+    <$> withFieldErrors (inputText "Name" "" `prove` notEmpty "Name is required")+    <*> withFieldErrors (inputText "Email" "" `prove` validEmail (const "Not an email address"))++view :: NanoUI ()+view = do+  submitted <- nanoFormSubmit "signup" "Sign up" signup+  case submitted of+    Just (Signup name _) -> label ("Welcome, " <> name)+    Nothing -> pure ()+```++`nanoFormSubmit` adds a submit button and yields the value on the frame the form+is submitted. `nanoFormLive` yields the value whenever the form is valid,+`nanoFormEx` takes a `FormConfig`, and `runNanoForm` returns the form's view and+result separately.++## Running++```sh+cabal run nano-ui-form-example -f sdl+```++The example needs `nano-ui-sdl`, behind this package's `sdl` flag (off by+default, and on in this repository's `cabal.project`). The library itself+does not depend on a backend.
+ examples/FormDemo.hs view
@@ -0,0 +1,179 @@+-- | A registration form with validated fields and a view of the value it+-- decodes to.+module FormDemo (formDemoUi) where++import Control.Monad (forM_, when)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Ditto.Types as Ditto+import NanoUI+  ( Color+  , NanoUI+  , button+  , card+  , colorToHex+  , colorRGBA+  , columnWith+  , danger+  , fillW+  , flex+  , fontMono+  , gap+  , grow+  , heading+  , kv+  , labelWith+  , maxW+  , minW+  , muted+  , padAll+  , rowWith+  , scrollWith+  , separator+  , tight+  , toolbar+  , useText+  )+import NanoUI.Form+  ( Form+  , FormView (..)+  , inRange+  , inputCheckbox+  , inputColor+  , inputEnumSelect+  , inputPassword+  , inputSlider+  , inputTextArea+  , inputTextWithPlaceholder+  , maxLength+  , minLength+  , notEmpty+  , prove+  , resetForm+  , runNanoForm+  , validEmail+  , withFieldErrors+  )++-- | Account tiers, picked with an enum select.+data AccountTier = Starter | Developer | Professional | Enterprise+  deriving (Eq, Show, Bounded, Enum)++-- | The value the form decodes to.+data Registration = Registration+  { regUsername   :: !Text+  , regEmail      :: !Text+  , regPassword   :: !Text+  , regAge        :: !Float+  , regTier       :: !AccountTier+  , regThemeColor :: !Color+  , regSubscribe  :: !Bool+  , regBio        :: !Text+  } deriving (Eq, Show)++-- | One validated field for each 'Registration' field.+registrationForm :: Form Text Registration+registrationForm =+  Registration+    <$> withFieldErrors+          (inputTextWithPlaceholder "e.g. adalovelace" "Username" "Ada"+            `prove` notEmpty "Username is required"+            `prove` minLength 3 (const "Must be at least 3 characters")+            `prove` maxLength 20 (const "Must be 20 characters or fewer"))+    <*> withFieldErrors+          (inputTextWithPlaceholder "e.g. ada@example.com" "Email" "ada@example.com"+            `prove` notEmpty "Email address is required"+            `prove` validEmail (const "Invalid email address format (e.g. name@domain.com)"))+    <*> withFieldErrors+          (inputPassword "Password" "correcthorse"+            `prove` notEmpty "Password is required"+            `prove` minLength 8 (const "Password must be at least 8 characters long"))+    <*> withFieldErrors+          (inputSlider "Age" 13 100 28+            `prove` inRange 18 100 (const "Must be at least 18 years old for this account tier"))+    <*> inputEnumSelect "Account Tier" Developer+    <*> inputColor "Accent Color" (colorRGBA 99 102 241 255)+    <*> inputCheckbox "Subscribe to release announcements and updates" True+    <*> withFieldErrors+          (inputTextArea "Developer Bio" "Writes GUI applications in Haskell with nano-ui and ditto."+            `prove` maxLength 160 (const "Bio must be 160 characters or fewer"))++formatRegistration :: Registration -> Text+formatRegistration r =+  "User @" <> regUsername r <> " (" <> regEmail r <> "), Age: "+    <> T.pack (show (round (regAge r) :: Int))+    <> ", Tier: " <> T.pack (show (regTier r))+    <> ", Color: " <> colorToHex (regThemeColor r)+    <> ", Subscribed: " <> (if regSubscribe r then "Yes" else "No")++formDemoUi :: NanoUI ()+formDemoUi = do+  (submittedMsg, setSubmitted) <- useText ""+  (view', res) <- runNanoForm "user_reg" registrationForm+  let mReg = case res of+        Ditto.Ok (Ditto.Proved _ a) -> Just a+        Ditto.Error _               -> Nothing+      renderedView = case res of+        Ditto.Error errs -> Ditto.unView view' errs+        Ditto.Ok _       -> Ditto.unView view' []+  scrollWith (tight . grow) $+    columnWith (padAll 20 . gap 16 . fillW) $ do+      toolbar $ do+        columnWith (tight . gap 2) $ do+          heading "nano-ui-form"+          muted "Forms built with ditto, drawn with nano-ui"+        flex+        muted "Press ESC to exit"+      separator+      rowWith (tight . gap 20 . fillW) $ do+        columnWith (tight . gap 12 . fillW) $ do+          card $ do+            heading "User Profile & Registration"+            muted "Fields validate as you type."+            separator+            runFormView renderedView+            separator+            rowWith (tight . gap 10 . fillW) $ do+              btnSubmit <- button "Submit Registration"+              btnReset  <- button "Reset Form"+              when btnSubmit $ do+                case mReg of+                  Just reg -> setSubmitted ("Successfully registered: " <> formatRegistration reg)+                  Nothing  -> setSubmitted "Submission failed: Please fix the highlighted validation errors."+              when btnReset $ do+                resetForm "user_reg"+                setSubmitted "Form has been reset to defaults."++        columnWith (tight . gap 12 . minW 340 . maxW 380) $ do+          card $ do+            heading "Decoded value"+            muted "The registration the form decodes to, or its errors."+            separator+            case res of+              Ditto.Ok (Ditto.Proved _ reg) -> do+                heading "Status: VALID"+                separator+                kv "Username" (regUsername reg)+                kv "Email" (regEmail reg)+                kv "Age" (T.pack (show (round (regAge reg) :: Int)) <> " years old")+                kv "Account Tier" (T.pack (show (regTier reg)))+                kv "Color Hex" (colorToHex (regThemeColor reg))+                kv "Newsletter" (if regSubscribe reg then "Active" else "Inactive")+                separator+                columnWith (tight . gap 4 . fillW) $ do+                  muted "Bio:"+                  labelWith (tight . fillW . maxW 350 . fontMono) (regBio reg)+              Ditto.Error errs -> do+                danger "Status: INVALID / INCOMPLETE"+                separator+                heading "Active Validation Errors:"+                forM_ errs $ \(_, errMsg) -> do+                  danger ("• " <> errMsg)++          card $ do+            heading "Submission Activity"+            muted "Record of last form submission:"+            separator+            if T.null submittedMsg+              then muted "No submission attempted yet."+              else labelWith (tight . fillW . maxW 350 . fontMono) submittedMsg
+ examples/Main.hs view
@@ -0,0 +1,19 @@+module Main (main) where++import FormDemo (formDemoUi)+import NanoUI (Key (KeyEscape), Size (..), inputKeys, inputKeysElem)+import NanoUI.Backend.Sdl+  ( SdlOptions (..)+  , defaultSdlOptions+  , runSdlApp+  )++main :: IO ()+main =+  runSdlApp+    defaultSdlOptions+      { sdlWindowTitle = "nano-ui-form example"+      , sdlWindowSize = Size 1100 800+      , sdlAppShouldQuit = \inp -> inputKeysElem KeyEscape (inputKeys inp)+      }+    formDemoUi
+ lib/NanoUI/Form.hs view
@@ -0,0 +1,99 @@+-- | Validated forms for nano-ui, built on ditto. A 'Form' is an applicative+-- value whose inputs are nano-ui widgets; run one in a view with+-- 'nanoFormLive', 'nanoFormSubmit', 'nanoFormEx' or 'runNanoForm'.+module NanoUI.Form+  ( -- * Core Form Types+    Form+  , FormView (..)+  , FormInput (..)+  , FormUI (..)+  , liftNanoUI+  , FormStatus (..)+  , FormMode (..)+  , FormConfig (..)+  , defaultFormConfig++    -- * Named Form Inputs+  , inputText+  , inputTextWithPlaceholder+  , inputPassword+  , inputTextArea+  , inputCheckbox+  , inputSlider+  , inputSelect+  , inputEnumSelect+  , inputRadio+  , inputEnumRadio+  , inputColor+  , label+  , separator+  , errors+  , childErrors+  , withErrors+  , withChildErrors+  , withFieldErrors++    -- * Validation & Proofs+  , module NanoUI.Form.Validation++    -- * Presentation & Layout+  , module NanoUI.Form.Widgets++    -- * Form Runners+  , runNanoForm+  , nanoFormLive+  , nanoFormSubmit+  , nanoFormEx+  , resetForm++    -- * Re-exports from Ditto+  , Ditto.FormRange (..)+  , Ditto.FormId (..)+  , Ditto.Result (..)+  , Ditto.Proved (..)+  , Ditto.hoistForm+  , Ditto.view+  , Ditto.mapView+  , (Ditto.@$)+  ) where++import qualified Ditto.Core as Ditto+import qualified Ditto.Types as Ditto+import NanoUI.Form.Named+  ( childErrors+  , errors+  , inputCheckbox+  , inputColor+  , inputEnumRadio+  , inputEnumSelect+  , inputPassword+  , inputRadio+  , inputSelect+  , inputSlider+  , inputText+  , inputTextWithPlaceholder+  , inputTextArea+  , label+  , separator+  , withChildErrors+  , withErrors+  , withFieldErrors+  )+import NanoUI.Form.Backend (FormInput (..), FormUI (..), liftNanoUI)+import NanoUI.Form.Runner+  ( nanoFormEx+  , nanoFormLive+  , nanoFormSubmit+  , resetForm+  , runNanoForm+  )+import NanoUI.Form.Types+  ( Form+  , FormConfig (..)+  , FormMode (..)+  , FormStatus (..)+  , FormView (..)+  , defaultFormConfig+  )+import NanoUI.Form.Validation+import NanoUI.Form.Widgets
+ lib/NanoUI/Form/Backend.hs view
@@ -0,0 +1,223 @@+-- | The ditto environment forms run in: field input values, form prefixes and+-- submitted state, kept in the widget store.+module NanoUI.Form.Backend+  ( FormInput (..)+  , formInputToText+  , FormUI (..)+  , liftNanoUI+  , getActiveFormPrefix+  , withFormPrefix+  , withFormWidgets+  , updateFieldInput+  , markFormSubmitted+  , isFormSubmitted+  , resetFormState+    -- * Stored form state, for tests+  , FormStateStore (..)+  , emptyFormStateStore+  , getFormStore+  , setFormStore+  , setActiveFormPrefix+  ) where++import Control.Monad (when, (<$!>))+import Data.Dynamic (fromDynamic, toDyn)+import qualified Data.IntMap.Strict as IM+import qualified Data.Map.Strict as Map+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TB+import qualified Data.Text.Lazy.Builder.Int as TB+import qualified Data.Text.Lazy.Builder.RealFloat as TB+import Data.Hashable (hash)+import Data.Maybe (fromMaybe)+import qualified Ditto.Backend as Ditto+import Ditto.Backend+  ( FormError (..)+  , commonFormErrorText+  )+import Ditto.Core (Environment (..))+import Ditto.Types (Value (..), encodeFormId)+import GHC.Generics (Generic)+import Effectful.Exception (bracket)+import NanoUI (NanoUI, uiIO, withKey)+import NanoUI.Monad (askContext)+import NanoUI.Context (Context, getStore, markDirty, setStore)+import NanoUI.Store (WidgetStore (..))++-- | A form field's raw input value, before parsing.+data FormInput+  = FormInputText !Text+  | FormInputBool !Bool+  | FormInputInt !Int+  | FormInputFloat !Float+  | FormInputList ![Text]+  deriving stock (Eq, Show, Generic)++-- | String representation of a 'FormInput'+formInputToText :: FormInput -> Text+formInputToText (FormInputText t) = t+formInputToText (FormInputBool b) = if b then "true" else "false"+formInputToText (FormInputInt i) = TL.toStrict (TB.toLazyText (TB.decimal i))+formInputToText (FormInputFloat f) = TL.toStrict (TB.toLazyText (TB.realFloat f))+formInputToText (FormInputList ts) = T.intercalate "," ts++-- | Internal store for form state across UI frames.+data FormStateStore = FormStateStore+  { fssInputs    :: !(Map.Map Text FormInput)+  , fssSubmitted :: !Bool+  } deriving stock (Eq, Show, Generic)++-- | Empty form state store.+emptyFormStateStore :: FormStateStore+emptyFormStateStore = FormStateStore Map.empty False++-- Keep reset identity alongside the form's values without exposing it in the+-- public FormStateStore. A new generation starts fresh form-local widget state,+-- including composite controls and text-area buffers.+data StoredForm = StoredForm+  { sfGeneration :: !Int+  , sfState      :: !FormStateStore+  }+  deriving (Eq)++-- | Form execution monad wrapping 'NanoUI'.+newtype FormUI a = FormUI { unFormUI :: NanoUI a }+  deriving newtype (Functor, Applicative, Monad)++-- | Lift a 'NanoUI' action into 'FormUI'.+liftNanoUI :: NanoUI a -> FormUI a+liftNanoUI = FormUI++-- | 'FormInput' instance for 'FormInput' allowing ditto decoding.+instance Ditto.FormInput FormInput where+  type FileType FormInput = ()++  getInputText (FormInputText t) = Right t+  getInputText (FormInputList (t : _)) = Right t+  getInputText other = Right (formInputToText other)++  getInputTexts (FormInputList ts) = ts+  getInputTexts other = [formInputToText other]++  getInputString fi = T.unpack <$> Ditto.getInputText fi++  getInputFile _ = Right ()++-- | 'FormError' instance translating common form errors into 'Text'.+instance FormError FormInput Text where+  commonFormError = commonFormErrorText formInputToText++-- | Well-known slot key in 'storeDyn' for the dynamically scoped form prefix.+activePrefixSlot :: Int+activePrefixSlot = -0x464F524D -- -'FORM'++-- | Hash a form prefix to a unique 'IntMap' key.+formStoreKey :: Text -> Int+formStoreKey prefix = hash ("nano-ui-form:" :: Text, prefix)++-- | Retrieve the active form prefix in the current context.+getActiveFormPrefix :: Context -> IO Text+getActiveFormPrefix ctx = do+  ws <- getStore ctx+  pure $! fromMaybe "" (IM.lookup activePrefixSlot (storeDyn ws) >>= fromDynamic)++-- | Set the active form prefix in the current context.+setActiveFormPrefix :: Context -> Text -> IO ()+setActiveFormPrefix ctx prefix = do+  ws <- getStore ctx+  setStore ctx ws {storeDyn = IM.insert activePrefixSlot (toDyn prefix) (storeDyn ws)}++-- | Evaluate or render a form under its own prefix, restoring the enclosing+-- prefix afterwards. Restore only this slot, so field updates survive the scope.+withFormPrefix :: Text -> NanoUI a -> NanoUI a+withFormPrefix prefix action = do+  ctx <- askContext+  let restorePrefix previous = uiIO $ do+        ws <- getStore ctx+        setStore ctx ws+          { storeDyn = IM.alter (const previous) activePrefixSlot (storeDyn ws)+          }+  bracket+    (uiIO $ IM.lookup activePrefixSlot . storeDyn <$> getStore ctx)+    restorePrefix+    (\_ -> uiIO (setActiveFormPrefix ctx prefix) >> action)++-- | Stable widget identity for a form, renewed when its state is reset.+withFormWidgets :: Text -> NanoUI a -> NanoUI a+withFormWidgets prefix action = do+  ctx <- askContext+  stored <- uiIO (getStoredForm ctx prefix)+  withKey (prefix, sfGeneration stored) action++getStoredForm :: Context -> Text -> IO StoredForm+getStoredForm ctx prefix = do+  ws <- getStore ctx+  -- Resolve the lookup here rather than returning a thunk over the whole store.+  pure $! fromMaybe (StoredForm 0 emptyFormStateStore) (IM.lookup (formStoreKey prefix) (storeDyn ws) >>= fromDynamic)++setStoredForm :: Context -> Text -> StoredForm -> IO ()+setStoredForm ctx prefix !stored = do+  ws <- getStore ctx+  setStore ctx ws {storeDyn = IM.insert (formStoreKey prefix) (toDyn stored) (storeDyn ws)}++-- | Retrieve the 'FormStateStore' for a given form prefix.+getFormStore :: Context -> Text -> IO FormStateStore+getFormStore ctx prefix = sfState <$!> getStoredForm ctx prefix++-- | Persist the 'FormStateStore' for a given form prefix.+setFormStore :: Context -> Text -> FormStateStore -> IO ()+setFormStore ctx prefix fss = do+  stored <- getStoredForm ctx prefix+  setStoredForm ctx prefix stored {sfState = fss}++-- Form state lives in a Dynamic slot, which the core cannot compare. Keep+-- equality and redraw notification here rather than in each mutation.+modifyFormStore :: Context -> Text -> (FormStateStore -> FormStateStore) -> IO ()+modifyFormStore ctx prefix update =+  modifyStoredForm ctx prefix (\stored -> stored {sfState = update (sfState stored)})++modifyStoredForm :: Context -> Text -> (StoredForm -> StoredForm) -> IO ()+modifyStoredForm ctx prefix update = do+  previous <- getStoredForm ctx prefix+  let next = update previous+  when (next /= previous) $ do+    setStoredForm ctx prefix next+    markDirty ctx++-- | Update a specific field's input in the form store.+updateFieldInput :: Context -> Text -> Text -> FormInput -> IO ()+updateFieldInput ctx prefix fieldKey inputVal =+  modifyFormStore ctx prefix $ \fss ->+    fss {fssInputs = Map.insert fieldKey inputVal (fssInputs fss)}++-- | Mark a form as submitted.+markFormSubmitted :: Context -> Text -> Bool -> IO ()+markFormSubmitted ctx prefix isSubmitted =+  modifyFormStore ctx prefix (\fss -> fss {fssSubmitted = isSubmitted})++-- | Check if a form has been submitted.+isFormSubmitted :: Context -> Text -> IO Bool+isFormSubmitted ctx prefix = do+  fss <- getFormStore ctx prefix+  pure (fssSubmitted fss)++-- | Reset values and renew widget identity so cached control state cannot+-- repopulate the form with its old values on the next frame.+resetFormState :: Context -> Text -> IO ()+resetFormState ctx prefix = modifyStoredForm ctx prefix $ \stored ->+  if sfState stored == emptyFormStateStore+    then stored+    else StoredForm (sfGeneration stored + 1) emptyFormStateStore++-- | Environment instance for 'FormUI' connecting ditto to nano-ui's context store.+instance Environment FormUI FormInput where+  environment fid = FormUI $ do+    ctx <- askContext+    prefix <- uiIO (getActiveFormPrefix ctx)+    fss <- uiIO (getFormStore ctx prefix)+    let fieldKey = encodeFormId fid+    pure $ case Map.lookup fieldKey (fssInputs fss) of+      Just val -> Found val+      Nothing  -> Default
+ lib/NanoUI/Form/Field.hs view
@@ -0,0 +1,75 @@+-- | Shared widget-to-form plumbing. Naming and validation stay with ditto;+-- this module only adapts immediate-mode controls to persistent field values.+module NanoUI.Form.Field+  ( fieldView+  , decodeBool+  , decodeFloatInput+  , decodeInt+  , fieldErrors+  , enumField+  )+where++import Control.Monad (when)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text qualified as T+import Ditto.Types (FormId, encodeFormId)+import NanoUI (NanoUI, Response, columnWith, fillW, gap, tight, uiIO, withKey)+import NanoUI.Form.Backend (FormInput (..), getActiveFormPrefix, updateFieldInput)+import NanoUI.Form.Types (FormView (..))+import NanoUI.Form.Widgets (defaultErrorView)+import NanoUI.Monad (askContext)+import Text.Read (readMaybe)++-- | Keep the label and control in the same stable field scope. Some controls+-- report activation rather than change, so callers supply the response flag.+fieldView ::+  Eq a =>+  (Response -> Bool)+  -> (a -> FormInput)+  -> (a -> NanoUI (Response, a))+  -> FormId+  -> a+  -> FormView+fieldView changed encode widget formId value = FormView $ withKey fieldKey $ do+  ctx <- askContext+  prefix <- uiIO (getActiveFormPrefix ctx)+  (response, newValue) <- widget value+  when (changed response || newValue /= value) $+    uiIO (updateFieldInput ctx prefix fieldKey (encode newValue))+ where+  fieldKey = encodeFormId formId++decodeBool :: Bool -> FormInput -> Bool+decodeBool _ (FormInputBool value) = value+decodeBool _ (FormInputText value) = value == "true"+decodeBool initial _ = initial++decodeFloatInput :: Float -> FormInput -> Float+decodeFloatInput _ (FormInputFloat value) = value+decodeFloatInput initial (FormInputText value) = fromMaybe initial (readMaybe (T.unpack value))+decodeFloatInput initial _ = initial++decodeInt :: Int -> FormInput -> Int+decodeInt _ (FormInputInt value) = value+decodeInt initial (FormInputText value) = fromMaybe initial (readMaybe (T.unpack value))+decodeInt initial _ = initial++fieldErrors :: FormView -> [Text] -> FormView+fieldErrors (FormView widget) errs = FormView $+  columnWith (tight . gap 4 . fillW) $ do+    widget+    runFormView (defaultErrorView errs)++-- | Widget indices are zero-based even when an Enum's bounds are not.+enumField ::+  forall a f.+  (Bounded a, Enum a, Show a, Functor f) => ([Text] -> Int -> f Int) -> a -> f a+enumField widget initial =+  fromIndex <$> widget options (fromEnum initial - lower)+ where+  values = [minBound .. maxBound] :: [a]+  options = map (T.pack . show) values+  lower = fromEnum (minBound :: a)+  fromIndex index = toEnum (lower + max 0 (min (length values - 1) index))
+ lib/NanoUI/Form/Named.hs view
@@ -0,0 +1,181 @@+-- | Named form inputs: each takes a name that identifies the field and is+-- shown as its label. "NanoUI.Form" re-exports these.+module NanoUI.Form.Named+  ( inputText+  , inputTextWithPlaceholder+  , inputPassword+  , inputTextArea+  , inputCheckbox+  , inputSlider+  , inputSelect+  , inputEnumSelect+  , inputRadio+  , inputEnumRadio+  , inputColor+  , label+  , separator+  , errors+  , childErrors+  , withErrors+  , withChildErrors+  , withFieldErrors+  )+where++import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Ditto.Backend (FormError)+import Ditto.Core qualified as Ditto+import Ditto.Generalized.Named qualified as Named+import NanoUI+  ( Color+  , NanoUI+  , Response+  , TextInputConfig (..)+  , checkbox'+  , colorFromHex+  , colorPicker'+  , colorToHex+  , defaultTextInputConfig+  , radio'+  , respChanged+  , respClicked+  , select'+  , slider'+  , textArea'+  , textInput'+  , textInputConfigured'+  )+import NanoUI qualified as NUI+import NanoUI.Form.Field+  ( decodeBool+  , decodeFloatInput+  , decodeInt+  , enumField+  , fieldErrors+  , fieldView+  )+import NanoUI.Form.Backend (FormInput (..), formInputToText)+import NanoUI.Form.Types (Form, FormView (..))++-- | Single-line text input field.+inputText :: FormError FormInput err => Text -> Text -> Form err Text+inputText = textField textInput'++-- | Single-line text input field with custom placeholder text.+inputTextWithPlaceholder ::+  FormError FormInput err => Text -> Text -> Text -> Form err Text+inputTextWithPlaceholder placeholder = textField (textInputConfigured' defaultTextInputConfig {ticPlaceholder = placeholder})++-- | Password text input masking entered characters.+inputPassword :: FormError FormInput err => Text -> Text -> Form err Text+inputPassword = textField (textInputConfigured' defaultTextInputConfig {ticPassword = True})++-- | Multi-line text area input.+inputTextArea :: FormError FormInput err => Text -> Text -> Form err Text+inputTextArea = textField textArea'++textField ::+  FormError FormInput err =>+  (Text -> NanoUI (Response, Text)) -> Text -> Text -> Form err Text+textField widget name =+  Named.input+    name+    (Right . formInputToText)+    (fieldView respChanged FormInputText (labelled name widget))++labelled :: Text -> (a -> NanoUI b) -> a -> NanoUI b+labelled name widget value = NUI.label name >> widget value++-- | Checkbox toggle input.+inputCheckbox :: FormError FormInput err => Text -> Bool -> Form err Bool+inputCheckbox name initial =+  Named.input+    name+    (Right . decodeBool initial)+    (fieldView respClicked FormInputBool (checkbox' name))+    initial++-- | Floating-point slider input across the range @[minV, maxV]@.+inputSlider ::+  FormError FormInput err => Text -> Float -> Float -> Float -> Form err Float+inputSlider name minV maxV initial =+  Named.input+    name+    (Right . decodeFloatInput initial)+    (fieldView respChanged FormInputFloat (labelled name (slider' minV maxV)))+    initial++-- | Dropdown selection in fold order (returns selected index).+inputSelect :: (Foldable f, FormError FormInput err) => Text -> f Text -> Int -> Form err Int+inputSelect name options initial =+  Named.input+    name+    (Right . decodeInt initial)+    (fieldView respChanged FormInputInt (labelled name (select' options)))+    initial++-- | Dropdown selection for any bounded enumeration type.+inputEnumSelect ::+  forall a err.+  (Bounded a, Enum a, Show a, FormError FormInput err) => Text -> a -> Form err a+inputEnumSelect name = enumField (inputSelect name)++-- | Radio button group (returns selected index).+inputRadio :: (Foldable f, FormError FormInput err) => Text -> f Text -> Int -> Form err Int+inputRadio name options initial =+  Named.input+    name+    (Right . decodeInt initial)+    (fieldView respChanged FormInputInt (labelled name (radio' options)))+    initial++-- | Radio button group for any bounded enumeration type.+inputEnumRadio ::+  forall a err.+  (Bounded a, Enum a, Show a, FormError FormInput err) => Text -> a -> Form err a+inputEnumRadio name = enumField (inputRadio name)++-- | Color picker input.+inputColor :: FormError FormInput err => Text -> Color -> Form err Color+inputColor name initial =+  Named.input+    name+    ( \case+        FormInputText t -> Right (fromMaybe initial (colorFromHex t))+        _ -> Right initial+    )+    ( fieldView+        respChanged+        (FormInputText . colorToHex)+        (labelled name colorPicker')+    )+    initial++-- | Static label inside a form.+label :: Text -> Form err ()+label txt = Ditto.view (FormView (NUI.label txt))++-- | Visual separator line inside a form.+separator :: Form err ()+separator = Ditto.view (FormView NUI.separator)++-- | Render error messages originating directly from this form node.+errors :: ([err] -> FormView) -> Form err ()+errors = Named.errors++-- | Render error messages originating from this form node and any descendant nodes.+childErrors :: ([err] -> FormView) -> Form err ()+childErrors = Named.childErrors++-- | Wrap a form with a custom error handler for its direct errors.+withErrors :: (FormView -> [err] -> FormView) -> Form err a -> Form err a+withErrors = Named.withErrors++-- | Wrap a form with a custom error handler for errors from it or any child.+withChildErrors :: (FormView -> [err] -> FormView) -> Form err a -> Form err a+withChildErrors = Named.withChildErrors++-- | Automatically display validation errors directly below the widget.+withFieldErrors :: Form Text a -> Form Text a+withFieldErrors = withChildErrors fieldErrors
+ lib/NanoUI/Form/Runner.hs view
@@ -0,0 +1,124 @@+-- | Running a form in a view: live validation, a submit button, a configured+-- runner, a deferred view, and reset.+module NanoUI.Form.Runner+  ( runNanoForm+  , nanoFormLive+  , nanoFormSubmit+  , nanoFormEx+  , resetForm+  ) where++import Control.Monad (when)+import Data.Text (Text)+import qualified Ditto.Core as Ditto+import qualified Ditto.Types as Ditto+import NanoUI+  ( Key (KeyEnter)+  , NanoUI+  , button+  , column+  , inputKeys+  , inputKeysElem+  , uiIO+  , whenM+  )+import NanoUI.Monad (askContext, askInput)+import NanoUI.Form.Backend+  ( FormUI (..)+  , isFormSubmitted+  , markFormSubmitted+  , resetFormState+  , withFormPrefix+  , withFormWidgets+  )+import NanoUI.Form.Types+  ( Form+  , FormConfig (..)+  , FormMode (..)+  , FormStatus (..)+  , FormView (..)+  , defaultFormConfig+  )++-- | Evaluate a formlet and return its view and result. The view retains its+-- prefix even when rendered after other forms or inside another form's view.+runNanoForm :: Text -> Form err a -> NanoUI (Ditto.View err FormView, Ditto.Result err (Ditto.Proved a))+runNanoForm prefix form = withNanoForm prefix form $ \view result -> do+  let scopedView (FormView action) = FormView (withFormPrefix prefix action)+  pure (scopedView <$> view, result)++-- Immediate runners evaluate and render in one prefix scope. Only a deferred+-- view returned by runNanoForm needs to re-enter that scope when it is rendered.+withNanoForm ::+  Text+  -> Form err a+  -> (Ditto.View err FormView -> Ditto.Result err (Ditto.Proved a) -> NanoUI b)+  -> NanoUI b+withNanoForm prefix form consume = withFormPrefix prefix $ do+  (view, result) <- unFormUI (Ditto.runForm prefix form)+  let keyedView (FormView action) = FormView (withFormWidgets prefix action)+  consume (keyedView <$> view) result++-- | Default form runner: renders the form every frame with live validation+-- and yields @Just a@ whenever it is valid.+nanoFormLive :: Text -> Form Text a -> NanoUI (Maybe a)+nanoFormLive prefix form = do+  status <- nanoFormEx defaultFormConfig prefix form+  pure $ case status of+    FormValid a -> Just a+    FormInvalid _ -> Nothing++-- | Run a form with an integrated submit button.+-- Validation errors are only displayed after the first submission attempt.+-- Returns @Just a@ only on a valid submission.+nanoFormSubmit :: Text -> Text -> Form Text a -> NanoUI (Maybe a)+nanoFormSubmit prefix submitLabel form = do+  ctx <- askContext+  inp <- askInput+  submittedBefore <- uiIO (isFormSubmitted ctx prefix)+  withNanoForm prefix form $ \view' res -> do+    btnClicked <- column $ do+      renderResult submittedBefore view' res+      button submitLabel+    let enterPressed = inputKeysElem KeyEnter (inputKeys inp)+        clickedSubmit = btnClicked || enterPressed+    when clickedSubmit $+      uiIO (markFormSubmitted ctx prefix True)+    pure $ case (clickedSubmit, res) of+      (True, Ditto.Ok (Ditto.Proved _ a)) -> Just a+      _                                  -> Nothing++-- | Detailed form runner with custom configuration.+nanoFormEx :: FormConfig -> Text -> Form Text a -> NanoUI (FormStatus a)+nanoFormEx cfg prefix form = do+  ctx <- askContext+  submittedBefore <- uiIO (isFormSubmitted ctx prefix)+  withNanoForm prefix form $ \view' res -> do+    let showErrors = case fcMode cfg of+          FormLive     -> True+          FormOnSubmit -> submittedBefore+    column $ do+      renderResult showErrors view' res+      case fcSubmitButton cfg of+        Just lbl ->+          whenM (button lbl) $+            uiIO (markFormSubmitted ctx prefix True)+        Nothing -> pure ()+    pure $ case res of+      Ditto.Ok (Ditto.Proved _ a) -> FormValid a+      Ditto.Error errs -> FormInvalid errs++renderResult :: Bool -> Ditto.View err FormView -> Ditto.Result err a -> NanoUI ()+renderResult showErrors view result =+  runFormView (Ditto.unView view errorsToShow)+  where+    errorsToShow = case result of+      Ditto.Error errs | showErrors -> errs+      _ -> []++-- | Reset input values and the corresponding widget state for a form prefix.+-- Re-evaluate the form on the next frame to render its defaults.+resetForm :: Text -> NanoUI ()+resetForm prefix = do+  ctx <- askContext+  uiIO (resetFormState ctx prefix)
+ lib/NanoUI/Form/Types.hs view
@@ -0,0 +1,53 @@+-- | Form, view, status and configuration types.+module NanoUI.Form.Types+  ( FormView (..)+  , Form+  , FormStatus (..)+  , FormMode (..)+  , FormConfig (..)+  , defaultFormConfig+  ) where++import Data.Text (Text)+import qualified Ditto.Core as Ditto+import Ditto.Types (FormRange)+import NanoUI (NanoUI)+import NanoUI.Form.Backend (FormInput, FormUI)++-- | View representation for forms in nano-ui.+-- Forms compose sequentially via '<*>' by sequencing their widget rendering actions.+newtype FormView = FormView { runFormView :: NanoUI () }++instance Semigroup FormView where+  FormView a <> FormView b = FormView (a >> b)++instance Monoid FormView where+  mempty = FormView (pure ())++-- | Type alias for a form producing @a@ with error type @err@.+type Form err a = Ditto.Form FormUI FormInput err FormView a++-- | Outcome of evaluating a form.+data FormStatus a+  = FormValid !a+  | FormInvalid ![(FormRange, Text)]+  deriving stock (Eq, Show, Functor)++-- | Validation mode for a form.+data FormMode+  = FormLive+  | FormOnSubmit+  deriving stock (Eq, Show)++-- | Configuration options for form execution.+data FormConfig = FormConfig+  { fcMode         :: !FormMode+  , fcSubmitButton :: !(Maybe Text)+  } deriving stock (Eq, Show)++-- | Default form configuration (live validation, no extra submit button).+defaultFormConfig :: FormConfig+defaultFormConfig = FormConfig+  { fcMode = FormLive+  , fcSubmitButton = Nothing+  }
+ lib/NanoUI/Form/Unnamed.hs view
@@ -0,0 +1,101 @@+-- | Form inputs without a label, with automatically numbered field names.+module NanoUI.Form.Unnamed+  ( inputText+  , inputPassword+  , inputTextArea+  , inputCheckbox+  , inputSlider+  , inputSelect+  , inputEnumSelect+  , errors+  , childErrors+  , withErrors+  , withChildErrors+  , withFieldErrors+  )+where++import Data.Text (Text)+import Ditto.Backend (FormError)+import Ditto.Generalized.Unnamed qualified as Unnamed+import NanoUI+  ( NanoUI+  , Response+  , TextInputConfig (..)+  , checkbox'+  , defaultTextInputConfig+  , respChanged+  , respClicked+  , select'+  , slider'+  , textArea'+  , textInput'+  , textInputConfigured'+  )+import NanoUI.Form.Backend (FormInput (..), formInputToText)+import NanoUI.Form.Field+  ( decodeBool+  , decodeFloatInput+  , decodeInt+  , enumField+  , fieldView+  )+import NanoUI.Form.Named+  ( childErrors+  , errors+  , withChildErrors+  , withErrors+  , withFieldErrors+  )+import NanoUI.Form.Types (Form)++-- | Auto-enumerated text input.+inputText :: FormError FormInput err => Text -> Form err Text+inputText = textField textInput'++-- | Auto-enumerated password input.+inputPassword :: FormError FormInput err => Text -> Form err Text+inputPassword = textField (textInputConfigured' defaultTextInputConfig {ticPassword = True})++-- | Auto-enumerated text area input.+inputTextArea :: FormError FormInput err => Text -> Form err Text+inputTextArea = textField textArea'++textField ::+  FormError FormInput err =>+  (Text -> NanoUI (Response, Text)) -> Text -> Form err Text+textField widget =+  Unnamed.input+    (Right . formInputToText)+    (fieldView respChanged FormInputText widget)++-- | Auto-enumerated checkbox toggle.+inputCheckbox :: FormError FormInput err => Text -> Bool -> Form err Bool+inputCheckbox lbl initial =+  Unnamed.input+    (Right . decodeBool initial)+    (fieldView respClicked FormInputBool (checkbox' lbl))+    initial++-- | Auto-enumerated slider input.+inputSlider ::+  FormError FormInput err => Float -> Float -> Float -> Form err Float+inputSlider minV maxV initial =+  Unnamed.input+    (Right . decodeFloatInput initial)+    (fieldView respChanged FormInputFloat (slider' minV maxV))+    initial++-- | Auto-enumerated select dropdown.+inputSelect :: (Foldable f, FormError FormInput err) => f Text -> Int -> Form err Int+inputSelect options initial =+  Unnamed.input+    (Right . decodeInt initial)+    (fieldView respChanged FormInputInt (select' options))+    initial++-- | Auto-enumerated select for bounded enums.+inputEnumSelect ::+  forall a err.+  (Bounded a, Enum a, Show a, FormError FormInput err) => a -> Form err a+inputEnumSelect = enumField inputSelect
+ lib/NanoUI/Form/Validation.hs view
@@ -0,0 +1,84 @@+-- | Proofs that parse and validate field values: numbers, text length,+-- ranges, email addresses, and custom predicates.+module NanoUI.Form.Validation+  ( -- * Proof combinators+    Proof (..)+  , prove+  , transformEither+  , transformEitherM+  , notNullProof+  , decimal+  , signedDecimal+  , realFrac+  , realFracSigned+    -- * Common UI validations+  , validate+  , satisfies+  , notEmpty+  , minLength+  , maxLength+  , inRange+  , validEmail+  , matches+  , customProof+  ) where++import Data.Text (Text)+import qualified Data.Text as T+import Ditto.Proof+  ( Proof (..)+  , decimal+  , notNullProof+  , prove+  , realFrac+  , realFracSigned+  , signedDecimal+  , transformEither+  , transformEitherM+  )++-- | Keep values that pass the check, rejecting the rest with an error built+-- from the rejected value.+validate :: Applicative m => (a -> Bool) -> (a -> err) -> Proof m err a a+validate ok mkErr = Proof (\x -> pure (if ok x then Right x else Left (mkErr x))) id++-- | Validate with an arbitrary predicate.+satisfies :: Applicative m => (a -> Bool) -> err -> Proof m err a a+satisfies ok err = validate ok (const err)++-- | Validate that a text string is not blank or whitespace-only.+notEmpty :: Applicative m => err -> Proof m err Text Text+notEmpty = satisfies (not . T.null . T.strip)++-- | Validate minimum string length.+minLength :: Applicative m => Int -> (Int -> err) -> Proof m err Text Text+minLength minLen mkErr = validate ((>= minLen) . T.length) (mkErr . T.length)++-- | Validate maximum string length.+maxLength :: Applicative m => Int -> (Int -> err) -> Proof m err Text Text+maxLength maxLen mkErr = validate ((<= maxLen) . T.length) (mkErr . T.length)++-- | Validate that a value falls within the inclusive range @[minVal, maxVal]@.+inRange :: (Applicative m, Ord a) => a -> a -> (a -> err) -> Proof m err a a+inRange minVal maxVal = validate (\x -> not (x < minVal || x > maxVal))++-- | Validate basic email structure (@user@domain.tld@).+validEmail :: Applicative m => (Text -> err) -> Proof m err Text Text+validEmail = validate isEmail+  where+    isEmail t =+      case T.splitOn "@" t of+        [user, domain] ->+          not (T.null user)+            && T.isInfixOf "." domain+            && not (T.isPrefixOf "." domain)+            && not (T.isSuffixOf "." domain)+        _ -> False++-- | Validate that a value equals an expected value (e.g. password confirmation).+matches :: (Applicative m, Eq a) => a -> err -> Proof m err a a+matches target = satisfies (== target)++-- | Create a proof from an 'Either' function and default initial fallback.+customProof :: Applicative m => (a -> Either err b) -> (a -> b) -> Proof m err a b+customProof f fallback = Proof (pure . f) fallback
+ lib/NanoUI/Form/Widgets.hs view
@@ -0,0 +1,63 @@+-- | Layout helpers for form views: containers, labelled rows and fields,+-- titled groups, and the default error view.+module NanoUI.Form.Widgets+  ( defaultErrorView+  , formContainer+  , formRow+  , formField+  , formGroup+  ) where++import Control.Monad (forM_)+import Data.Text (Text)+import NanoUI+  ( alignMid+  , card+  , columnWith+  , danger+  , fillW+  , gap+  , heading+  , label+  , padXY+  , calloutWith+  , themeRed+  , uiTheme+  , rowWith+  )+import NanoUI.Form.Types (FormView (..))++-- | Standard error view rendering a styled error callout directly below invalid fields.+defaultErrorView :: Foldable f => f Text -> FormView+defaultErrorView errs | null errs = FormView (pure ())+defaultErrorView errs = FormView $ do+  errColor <- themeRed <$> uiTheme+  calloutWith errColor (padXY 8 4 . gap 2) $ do+    forM_ errs $ \err ->+      danger ("• " <> err)++-- | Wrap a form view in a flex-growing column with standard form gap.+formContainer :: FormView -> FormView+formContainer (FormView inner) = FormView $ do+  columnWith (gap 10 . fillW) inner++-- | Horizontal layout putting a field label on the left and form control on the right.+formRow :: Text -> FormView -> FormView+formRow lbl (FormView inner) = FormView $ do+  rowWith (gap 8 . fillW . alignMid) $ do+      label lbl+      inner++-- | Vertical field layout placing a label directly above the form control.+formField :: Text -> FormView -> FormView+formField lbl (FormView inner) = FormView $ do+  columnWith (gap 3 . fillW) $ do+      label lbl+      inner++-- | Group related form fields into a titled visual card.+formGroup :: Text -> FormView -> FormView+formGroup title (FormView inner) = FormView $ do+  card $ do+    heading title+    columnWith (gap 6 . fillW) inner
+ nano-ui-form.cabal view
@@ -0,0 +1,111 @@+cabal-version:      3.4+name:               nano-ui-form+version:            0.1.0.0+synopsis:           Validated forms for nano-ui, built on ditto+description:+    Applicative forms whose inputs are nano-ui widgets, with validation errors+    shown under each field.+license:            MIT+license-file:       LICENSE+author:             goolord+maintainer:         zacharyachurchill@gmail.com+category:           Graphics+homepage:           https://github.com/goolord/nano-ui+bug-reports:        https://github.com/goolord/nano-ui/issues+build-type:         Simple+tested-with:        GHC ==9.10.3 || ==9.14.1+extra-doc-files:+    CHANGELOG.md+    README.md++source-repository head+    type:     git+    location: https://github.com/goolord/nano-ui.git+    subdir:   packages/nano-ui-form++common extensions+    default-language: GHC2024+    default-extensions:+        DuplicateRecordFields+        OverloadedStrings+        TypeFamilies++common warnings+  ghc-options:+    -Wall+    -Wextra+    -Wcompat+    -Widentities+    -Wincomplete-record-updates+    -Wincomplete-uni-patterns+    -Wmissing-export-lists+    -Wmissing-home-modules+    -Wpartial-fields+    -Wredundant-constraints+    -Wunused-packages++library+    import:           extensions+    import:           warnings+    exposed-modules:+        NanoUI.Form+        NanoUI.Form.Backend+        NanoUI.Form.Named+        NanoUI.Form.Runner+        NanoUI.Form.Types+        NanoUI.Form.Unnamed+        NanoUI.Form.Validation+        NanoUI.Form.Widgets+    other-modules:+        NanoUI.Form.Field+    build-depends:+        base >=4.20 && <4.23,+        containers >=0.6.7 && <0.9,+        ditto >=0.5 && <0.6,+        effectful-core >=2.5 && <2.8,+        hashable >=1.4 && <1.6,+        nano-ui ^>=0.1,+        text >=2.0 && <2.2+    hs-source-dirs:   lib++flag sdl+    description: Build the SDL3 window example+    manual: True+    default: False++executable nano-ui-form-example+    import:           extensions+    import:           warnings+    main-is:          Main.hs+    other-modules:    FormDemo+    ghc-options:      -rtsopts -threaded "-with-rtsopts=-N1 -A64m -T -I0"+    build-depends:+        base >=4.20 && <4.23,+        ditto >=0.5 && <0.6,+        nano-ui ^>=0.1,+        nano-ui-form,+        text >=2.0 && <2.2+    if flag(sdl)+        build-depends:+            nano-ui-sdl ^>=0.1+    if os(windows)+        ghc-options: -optl-mconsole+    if !flag(sdl)+        buildable: False+    hs-source-dirs:   examples++test-suite nano-ui-form-test+    import:           extensions+    import:           warnings+    type:             exitcode-stdio-1.0+    main-is:          Main.hs+    other-modules:    Scope+    ghc-options:      -rtsopts -threaded "-with-rtsopts=-M256m -N1"+    build-depends:+        base >=4.20 && <4.23,+        containers >=0.6.7 && <0.9,+        ditto >=0.5 && <0.6,+        nano-ui,+        nano-ui-form,+        text >=2.0 && <2.2+    hs-source-dirs:   test
+ test/Main.hs view
@@ -0,0 +1,143 @@+module Main (main) where++import Data.Int (Int8)+import Data.Text (Text)+import qualified Data.Sequence as Seq+import qualified Data.Text as T+import qualified Ditto.Types as Ditto+import NanoUI+  ( Input (..)+  , Size (..)+  , columnWith+  , emptyInput+  , maxW+  , minW+  , runNanoUI+  , tight+  )+import NanoUI.Testing (collectTextSpans, newContext, runFrame)+import NanoUI.Form+import NanoUI.Form.Backend (updateFieldInput)+import qualified NanoUI.Form.Unnamed as Unnamed+import System.IO (BufferMode (NoBuffering), hSetBuffering, stdout)+import Scope (check, runScopeTests)++data Person = Person+  { personName :: !Text+  , personAge  :: !Float+  , personOk   :: !Bool+  } deriving (Eq, Show)++failingForm :: Form Text Person+failingForm =+  Person+    <$> (inputText "name" "" `prove` notEmpty "Name is required")+    <*> (inputSlider "age" 0 100 12 `prove` inRange 18 100 (const "Must be at least 18"))+    <*> inputCheckbox "accepted" False++main :: IO ()+main = do+  hSetBuffering stdout NoBuffering+  putStrLn "=== Running nano-ui-form Test Suite ==="+  runScopeTests++  ctx <- newContext+  let inp = emptyInput { inputWindowSize = Size 60 20 }++  let collectionForm :: Form Text (Int, Int, Int)+      collectionForm = (,,)+        <$> inputSelect "select" (Seq.fromList ["First", "Second"]) 1+        <*> inputRadio "radio" (Seq.fromList ["First", "Second"]) 0+        <*> Unnamed.inputSelect (Just "Only") 0+  (_, collectionResult) <- runNanoUI ctx inp (runNanoForm "collections" collectionForm)+  case collectionResult of+    Ditto.Ok (Ditto.Proved _ values) ->+      check "Foldable form options preserve initial indices" (values == (1, 0, 0))+    Ditto.Error errs -> fail (show errs)++  putStrLn "\n--- Validation Failure & Errors (runNanoUI) ---"+  (_, res2) <- runNanoUI ctx inp (runNanoForm "failing" failingForm)+  case res2 of+    Ditto.Error errs -> do+      let errorMsgs = map snd errs+      check "Detected two validation errors" (length errs == 2)+      check "Caught Name is required" ("Name is required" `elem` errorMsgs)+      check "Caught Must be at least 18" ("Must be at least 18" `elem` errorMsgs)+    Ditto.Ok _ ->+      fail "Expected validation failure, but form succeeded"++  let enumForm :: Form Text (Int8, Int8, Int8)+      enumForm = (,,)+        <$> inputEnumSelect "select" (-42)+        <*> inputEnumRadio "radio" 42+        <*> Unnamed.inputEnumSelect (-12)+      checkEnums expected = do+        (_, result) <- runNanoUI ctx inp (runNanoForm "enums" enumForm)+        case result of+          Ditto.Ok (Ditto.Proved _ values) ->+            check "Enum fields use zero-based widget indices independently of enum bounds" (values == expected)+          Ditto.Error errs -> fail (show errs)+  checkEnums (-42, 42, -12)+  updateFieldInput ctx "enums" "select" (FormInputInt 0)+  updateFieldInput ctx "enums" "radio" (FormInputInt 255)+  checkEnums (minBound, maxBound, -12)+  updateFieldInput ctx "enums" "select" (FormInputInt (-10))+  updateFieldInput ctx "enums" "radio" (FormInputInt 300)+  checkEnums (minBound, maxBound, -12)++  putStrLn "\n--- Multi-field stability & no ID shift on error appearance/clear ---"+  let multiForm :: Form Text (Text, Float, Text)+      multiForm =+        (,,)+          <$> withFieldErrors (inputText "user" "Ada" `prove` minLength 3 (const "Too short"))+          <*> withFieldErrors (inputSlider "age" 10 100 25 `prove` inRange 18 100 (const "Must be 18+"))+          <*> withFieldErrors (inputText "bio" "Bio text" `prove` notEmpty "Bio required")++  -- Frame 1: Initial valid state+  (v1, r1) <- runNanoUI ctx inp (runNanoForm "multi" multiForm)+  case r1 of+    Ditto.Ok (Ditto.Proved _ (u, a, b)) -> do+      check "Initial valid form decoded" (u == "Ada" && a == 25 && b == "Bio text")+      runNanoUI ctx inp (runFormView (Ditto.unView v1 []))+    _ -> fail "Expected valid initial form"++  -- Frame 2: Update age to 15 (invalid)+  updateFieldInput ctx "multi" "age" (FormInputFloat 15)+  (v2, r2) <- runNanoUI ctx inp (runNanoForm "multi" multiForm)+  case r2 of+    Ditto.Error errs -> do+      check "Age failed validation" (length errs == 1)+      -- Render with error callout+      runNanoUI ctx inp (runFormView (Ditto.unView v2 errs))+    Ditto.Ok _ -> fail "Expected age validation error"++  -- Frame 3: User updates Bio to "Bio modified"+  updateFieldInput ctx "multi" "bio" (FormInputText "Bio modified")++  -- Frame 4: Fix age back to 30 (error clears)+  updateFieldInput ctx "multi" "age" (FormInputFloat 30)+  (v4, r4) <- runNanoUI ctx inp (runNanoForm "multi" multiForm)+  case r4 of+    Ditto.Ok (Ditto.Proved _ (u, a, b)) -> do+      check "Form valid again without sibling reset" (u == "Ada" && a == 30 && b == "Bio modified")+      runNanoUI ctx inp (runFormView (Ditto.unView v4 []))+    Ditto.Error errs -> fail $ "Expected valid form after fix, got: " ++ show errs++  putStrLn "\n--- Long error text wrapping ---"+  let emailErrorMsg = "Invalid email address format (e.g. name@domain.com)"+      longErrorForm :: Form Text Text+      longErrorForm = withFieldErrors (inputText "email" "bad-email" `prove` validEmail (\_ -> emailErrorMsg))+  (v7, r7) <- runNanoUI ctx inp (runNanoForm "longError" longErrorForm)+  case r7 of+    Ditto.Error errs -> do+      check "Caught long email error" (length errs == 1)+      let ui = columnWith (tight . minW 300 . maxW 360) (runFormView (Ditto.unView v7 errs))+      _ <- runFrame ctx inp ui+      spans <- collectTextSpans ctx+      let emailSpans = [t | (_, t, _, _, _) <- spans, "Invalid email" `T.isInfixOf` t || "name@domain.com" `T.isInfixOf` t]+      check "Email error message is rendered without being lost" (not (null emailSpans))+      let allText = T.unwords emailSpans+      check "Full email error text is preserved" ("Invalid email" `T.isInfixOf` allText && "name@domain.com" `T.isInfixOf` allText)+    Ditto.Ok _ -> fail "Expected email validation error"++  putStrLn "\n=== All nano-ui-form Tests Passed! ==="
+ test/Scope.hs view
@@ -0,0 +1,246 @@+module Scope (check, runScopeTests) where++import Control.Exception (IOException, try)+import Control.Monad (forM, forM_, unless, void)+import Data.IORef (writeIORef)+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Ditto.Core qualified as Ditto+import Ditto.Types qualified as Ditto+import NanoUI+  ( Input (..)+  , Key (KeyEnter)+  , NanoUI+  , Rect (..)+  , columnWith+  , fillW+  , inputKeysFromList+  , runNanoUI+  , uiIO+  )+import NanoUI.Context (ctxFocusId, ctxNodeArena)+import NanoUI.Form+import NanoUI.Form.Backend+  ( FormStateStore (..)+  , emptyFormStateStore+  , getActiveFormPrefix+  , getFormStore+  , markFormSubmitted+  , resetFormState+  , setActiveFormPrefix+  , setFormStore+  , updateFieldInput+  , withFormPrefix+  )+import NanoUI.Id (WidgetId)+import NanoUI.Layout.Arena+  ( NodeType (NodeCheckbox, NodeTextArea)+  , arenaCount+  , getNodeType+  , getRect+  , getWidgetId+  )+import NanoUI.Testing (Context, clearDirty, isDirty, newPixelContext, runFrame)+import NanoUI.Testing.Harness (clickPair, spanCenter, warmup2, withInputOff)++check :: String -> Bool -> IO ()+check message ok = unless ok (fail message)++runScopeTests :: IO ()+runScopeTests = do+  testDeferredViews+  testNestedViews+  testPrefixRestoration+  testFormInvalidation+  testSubmitPulse+  testResetWidgets+  testResetTextArea++checkboxes :: Context -> IO [(WidgetId, Rect)]+checkboxes = controlsOf NodeCheckbox++controlsOf :: NodeType -> Context -> IO [(WidgetId, Rect)]+controlsOf wanted ctx = do+  let+    arena = ctxNodeArena ctx+  count <- arenaCount arena+  concat+    <$> forM+      [0 .. count - 1]+      ( \index -> do+          nodeType <- getNodeType arena index+          if nodeType /= wanted+            then pure []+            else do+              wid <- getWidgetId arena index+              (x, y, w, h) <- getRect arena index+              pure [(wid, Rect x y w h)]+      )++enabledForm :: Form Text Bool+enabledForm = inputCheckbox "enabled" False++readEnabled :: Context -> Text -> IO Bool+readEnabled ctx prefix = do+  (_, result) <-+    runNanoUI ctx (withInputOff 400 240) (runNanoForm prefix enabledForm)+  case result of+    Ditto.Ok (Ditto.Proved _ value) -> pure value+    Ditto.Error _ -> fail "checkbox form unexpectedly failed validation"++testDeferredViews :: IO ()+testDeferredViews = do+  ctx <- newPixelContext+  let+    input = withInputOff 400 240+    ui :: NanoUI ()+    ui = columnWith fillW $ do+      (left, _) <- runNanoForm "left" enabledForm+      (right, _) <- runNanoForm "right" enabledForm+      runFormView (Ditto.unView left [] <> Ditto.unView right [])+  _ <- warmup2 ctx input ui+  controls <- checkboxes ctx+  case controls of+    [(leftId, leftRect), (rightId, _)] -> do+      check+        "same-named fields in different forms share a widget ID"+        (leftId /= rightId)+      let+        (press, release) = clickPair input (spanCenter leftRect)+      void (runFrame ctx press ui)+      void (runFrame ctx release ui)+      _ <- warmup2 ctx input ui+      check "deferred view wrote to the wrong form" =<< readEnabled ctx "left"+      check "editing one form changed another form" . not =<< readEnabled ctx "right"+    _ -> fail "expected two deferred checkbox fields"++testNestedViews :: IO ()+testNestedViews = do+  ctx <- newPixelContext+  setActiveFormPrefix ctx "host"+  let+    input = withInputOff 400 240+    nested = Ditto.view (FormView (void (nanoFormLive "inner" enabledForm)))+    outer = nested *> enabledForm+    ui = nanoFormLive "outer" outer+  _ <- warmup2 ctx input ui+  controls <- checkboxes ctx+  case controls of+    [_, (_, outerRect)] -> do+      let+        (press, release) = clickPair input (spanCenter outerRect)+      void (runFrame ctx press ui)+      void (runFrame ctx release ui)+      _ <- warmup2 ctx input ui+      check "field following a nested form lost its owner" =<< readEnabled ctx "outer"+      check "outer field wrote to the nested form" . not =<< readEnabled ctx "inner"+      check "form evaluation or rendering leaked its prefix" . (== "host")+        =<< getActiveFormPrefix ctx+    _ -> fail "expected nested and outer checkbox fields"++testPrefixRestoration :: IO ()+testPrefixRestoration = do+  ctx <- newPixelContext+  let+    input = withInputOff 400 240+  result <-+    try+      ( runNanoUI ctx input $ withFormPrefix "outer" $ withFormPrefix "inner" $ do+          uiIO (updateFieldInput ctx "inner" "value" (FormInputText "preserved"))+          uiIO (ioError (userError "form failed"))+      ) ::+      IO (Either IOException ())+  check "expected a form exception" (either (const True) (const False) result)+  check "exception leaked the active form prefix" . (== "")+    =<< getActiveFormPrefix ctx+  store <- getFormStore ctx "inner"+  check+    "prefix restoration discarded field updates"+    (Map.lookup "value" (fssInputs store) == Just (FormInputText "preserved"))++testFormInvalidation :: IO ()+testFormInvalidation = do+  ctx <- newPixelContext+  forM_+    [ updateFieldInput ctx "form" "field" (FormInputText "value")+    , markFormSubmitted ctx "form" True+    , resetFormState ctx "form"+    ]+    $ \update -> do+      clearDirty ctx+      update+      check "form mutation did not request a redraw" =<< isDirty ctx+      clearDirty ctx+      update+      check "an unchanged form mutation requested another redraw" . not+        =<< isDirty ctx++testSubmitPulse :: IO ()+testSubmitPulse = do+  ctx <- newPixelContext+  let+    input = withInputOff 400 240+    ui = nanoFormSubmit "submit" "Save" (pure (42 :: Int))+  initial <- warmup2 ctx input ui+  check "form submitted before activation" (initial == Nothing)+  (submitted, _, _, _) <-+    runFrame ctx input {inputKeys = inputKeysFromList [KeyEnter]} ui+  check "valid submission did not return its value" (submitted == Just 42)+  idle <- warmup2 ctx input ui+  check "a submitted form kept emitting values on idle frames" (idle == Nothing)++testResetWidgets :: IO ()+testResetWidgets = do+  ctx <- newPixelContext+  let+    input = withInputOff 400 240+    ui =+      columnWith fillW $+        (,)+          <$> nanoFormLive "reset-left" enabledForm+          <*> nanoFormLive "reset-right" enabledForm+  _ <- warmup2 ctx input ui+  controls <- checkboxes ctx+  case controls of+    [(_, leftRect), (rightId, rightRect)] -> do+      forM_ [leftRect, rightRect] $ \rect -> do+        let+          (press, release) = clickPair input (spanCenter rect)+        void (runFrame ctx press ui)+        void (runFrame ctx release ui)+      edited <- warmup2 ctx input ui+      check "checkboxes did not retain their edits" (edited == (Just True, Just True))+      runNanoUI ctx input (resetForm "reset-left")+      reset <- warmup2 ctx input ui+      check+        "reset did not restore defaults or changed another form"+        (reset == (Just False, Just True))+      after <- checkboxes ctx+      check+        "reset changed another form's widget identity"+        (map fst (drop 1 after) == [rightId])+      setFormStore ctx "reset-left" emptyFormStateStore+      persisted <- warmup2 ctx input ui+      check+        "writing form data revived a retired widget cache"+        (persisted == (Just False, Just True))+    _ -> fail "expected two reset-test checkboxes"++testResetTextArea :: IO ()+testResetTextArea = do+  ctx <- newPixelContext+  let+    input = withInputOff 400 240+    ui = nanoFormLive "reset-editor" (inputTextArea "notes" "initial")+  _ <- warmup2 ctx input ui+  controls <- controlsOf NodeTextArea ctx+  case controls of+    [(wid, _)] -> do+      writeIORef (ctxFocusId ctx) wid+      void (runFrame ctx input {inputChars = "edited"} ui)+      edited <- warmup2 ctx input ui+      check "text area did not retain its edit" (edited == Just "editedinitial")+      runNanoUI ctx input (resetForm "reset-editor")+      reset <- warmup2 ctx input ui+      check "reset retained the text area's cached buffer" (reset == Just "initial")+    _ -> fail "expected one reset-test text area"