threepenny-editors-0.5.6: examples/CRUD2.hs

{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE RecursiveDo           #-}
{-# LANGUAGE TypeApplications      #-}
module CRUD2 (main) where

import           Control.Monad
import           Data.Bifunctor
import           Data.List
import           Data.Map                             (Map)
import           Data.Set                             (Set)
import qualified Data.Map                             as Map
import qualified Data.Set                             as Set
import           Person2                              hiding (main)

import qualified Graphics.UI.Threepenny               as UI
import           Graphics.UI.Threepenny.Core          hiding (delete)
import           Graphics.UI.Threepenny.Editors       hiding (create)
import qualified Graphics.UI.Threepenny.Editors       as Editors
import           Graphics.UI.Threepenny.Editors.Types

type Database = Map Int Person

main :: IO ()
main = startGUI defaultConfig setup

setup :: Window -> UI ()
setup window = void $ mdo
    filterEditor <- Editors.create (editor @String) bFilter
    dbEditor     <- Editors.create (editorCollection dbEditorConfig editor) db

    -- debug <- UI.new # sink text (show <$> db)

    db :: Behavior (Maybe Int, Database) <-
      stepper (Nothing, mempty) $ head <$> unions
        [ edited dbEditor
        , (\kk -> first( (`mplus` (Set.lookupMin kk))
                       . (>>= \k -> guard (k `Set.member` kk) >> return k)))
          <$> options <*> db <@ edited filterEditor
        ]

    bFilter <- stepper "" (edited filterEditor)

    let dbEditorConfig ba = (defaultEditorCollectionConfig ba)
          { eccDisplay  = displayPerson . snd <$> ba
          , eccOptions  = options
          }
        options = applyFilter <$> bFilter <*> db

    void $ return window # set title "CRUD Example (editorCollection)"
    getBody window
      #+ [column [ render filterEditor
                 , string ""
                 , render dbEditor
                 , string ""
                 --, render debug
                 ]]
  where
   displayPerson db i =
     UI.option # set text (maybe "" showPerson (Map.lookup i db))
   showPerson :: Person -> String
   showPerson Person{..} = lastName ++ ", " ++ firstName

   applyFilter :: String -> (_,Database) -> Set Int
   applyFilter pat (_,db) =
     Set.fromList [ k | (k,Person{..}) <- Map.toList db
                      , pat `isPrefixOf` firstName || pat `isPrefixOf` lastName]