Autocomplete

Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
module Main (
    main
  ) where

import Control.Lens

import Data.Text (Text)
import qualified Data.Text as Text

import Data.Map (Map)
import qualified Data.Map as Map

import Reflex.Collection
import Reflex.Time

import Reflex.Dom

main ::
  IO ()
main =
  mainWidget exampleWidget

-- Adds items to the list
addItem ::
  MonadWidget t m =>
  m (Event t Text)
addItem = mdo
  -- We set up a text input
  ti <- textInput $ def
    -- that will get cleared when the user presses enter
    & textInputConfig_setValue .~ ("" <$ eAtEnter)

  let
    -- We want to look at the value of the text input ...
    dValue = ti ^. textInput_value

    -- ... when the user presses Enter ...
    eKeypress = ti ^. textInput_keypress
    isKey k   = (== k) . keyCodeLookup . fromIntegral
    eEnter    = ffilter (isKey Enter) eKeypress

    -- .. if the stripped text is not empty
    eAtEnter'  = Text.strip <$> current dValue <@ eEnter
    eAtEnter   = ffilter (not . Text.null) eAtEnter'

  -- Return the Event
  pure eAtEnter

-- Build up a list of items
itemList ::
  MonadWidget t m =>
  Event t Text ->              -- ^ the Event that fires when there is something to add
  m (Dynamic t (Map Int Text)) -- ^ the Dynamic Map of entries in the list
itemList eAdd = do

  -- Track the number of times eAdd has fired, so we can use that count
  -- as a key in our Map
  dCount <- count eAdd

  -- Accumulate a Map, starting from empty ...
  dMap <- foldDyn ($) Map.empty $
    -- ... by inserting the values from eAdd into it every time it fires
    Map.insert <$> current dCount <@> eAdd

  -- For every item we have added ...
  _ <- el "ul" . list dMap $
         -- ... display the text of the item
         el "li" . dynText

  -- Return the Map
  pure dMap

searchWidget ::
  MonadWidget t m =>
  Dynamic t (Map Int Text) -> -- ^ The Dynamic Map of entries to search through
  m ()
searchWidget dMapIn = do
  -- We set up a text input
  ti <- textInput def

  let
    -- We want to look at its value when the user types ...
    eValue''' = view textInput_input ti

  -- ... after 1 second of inactivity ...
  eValue'' <- debounce 1 eValue'''

  let
    -- ... and then strip the output ...
    eValue' = fmap Text.strip eValue''

    -- ... and break it up into different Events depending on whether
    -- the text input does or doesn't have text in it
    eValueClear = ffilter (Text.null) eValue'
    eValueSet = ffilter (not . Text.null) eValue'

  -- We build a list of output results, which starts empty
  dMapOut <- foldDyn ($) Map.empty . mergeWith (.) $ [
             -- If there is text to search for, filter out the results
               (\m t -> const $ Map.filter (Text.isInfixOf t) m) <$> current dMapIn <@> eValueSet
             -- otherwise clear the results
             , const Map.empty <$ eValueClear
             ]

  -- For every item in the results ...
  _ <- el "ul" . list dMapOut $
         -- ... display the text of the item
         el "li" . dynText

  pure ()

exampleWidget ::
  MonadWidget t m =>
  m ()
exampleWidget = mdo
  eSelect <- searchWidget dMap
  dMap <- itemList eAdd
  eAdd <- addItem
  pure ()

MainWithSelection.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
module Main (
    main
  ) where

import Control.Lens

import Data.Text (Text)
import qualified Data.Text as Text

import Data.Map (Map)
import qualified Data.Map as Map

import Data.Set (Set)
import qualified Data.Set as Set

import Reflex.Collection
import Reflex.Time

import Reflex.Dom

main ::
  IO ()
main =
  mainWidget exampleWidget

-- Adds items to the list
addItem ::
  MonadWidget t m =>
  m (Event t Text)
addItem = mdo
  -- We set up a text input
  ti <- textInput $ def
    -- that will get cleared when the user presses enter
    & textInputConfig_setValue .~ ("" <$ eAtEnter)

  let
    -- We want to look at the value of the text input ...
    dValue = ti ^. textInput_value

    -- ... when the user presses Enter ...
    eKeypress = ti ^. textInput_keypress
    isKey k   = (== k) . keyCodeLookup . fromIntegral
    eEnter    = ffilter (isKey Enter) eKeypress

    -- .. if the stripped text is not empty
    eAtEnter'  = Text.strip <$> current dValue <@ eEnter
    eAtEnter   = ffilter (not . Text.null) eAtEnter'

  -- Return the Event
  pure eAtEnter

-- Build up a list of items
itemList ::
  MonadWidget t m =>
  Dynamic t (Set Int) ->       -- ^ the Dynamic Set of selected entries
  Event t Text ->              -- ^ the Event that fires when there is something to add
  m (Dynamic t (Map Int Text)) -- ^ the Dynamic Map of entries in the list
itemList dSelected eAdd = do

  -- Track the number of times eAdd has fired, so we can use that count
  -- as a key in our Map
  dCount <- count eAdd

  -- Accumulate a Map, starting from empty ...
  dMap <- foldDyn ($) Map.empty $
    -- ... by inserting the values from eAdd into it every time it fires
    Map.insert <$> current dCount <@> eAdd

  -- For every item we have added ...
  _ <- el "ul" . listWithKey dMap $ \k dv -> do
         -- ... display the text of the item, with a class based on whether the item is
         -- in the set of selected entries
         let
           mkClass False = ""
           mkClass True = "selected"

           dClass = (mkClass . Set.member k) <$> dSelected

         elDynClass "li" dClass . dynText $ dv

  -- Return the Map
  pure dMap

searchWidget ::
  MonadWidget t m =>
  Dynamic t (Map Int Text) -> -- ^ The Dynamic Map of entries to search through
  m (Dynamic t (Set Int))
searchWidget dMapIn = do
  -- We set up a text input
  ti <- textInput def

  let
    -- We want to look at its value when the user types ...
    eValue''' = view textInput_input ti

  -- ... after 1 second of inactivity ...
  eValue'' <- debounce 1 eValue'''

  let
    -- ... and then strip the output ...
    eValue' = fmap Text.strip eValue''

    -- ... and break it up into different Events depending on whether
    -- the text input does or doesn't have text in it
    eValueClear = ffilter (Text.null) eValue'
    eValueSet = ffilter (not . Text.null) eValue'

  -- We build a list of output results, which starts empty
  dMapOut <- foldDyn ($) Map.empty . mergeWith (.) $ [
             -- If there is text to search for, filter out the results
               (\m t -> const $ Map.filter (Text.isInfixOf t) m) <$> current dMapIn <@> eValueSet
             -- otherwise clear the results
             , const Map.empty <$ eValueClear
             ]

  -- For every item in the results ...
  dMap <- el "ul" . listWithKey dMapOut $ \k dv -> do
         -- ... display the text of the item ...
         el "li" . dynText $ dv
         -- .. and return the key (we could do more here if we wanted to)
         pure k

  -- Return the keys from the map
  pure $ Map.keysSet <$> dMap

exampleWidget ::
  MonadWidget t m =>
  m ()
exampleWidget = mdo
  dSelected <- searchWidget dMap
  dMap <- itemList dSelected eAdd
  eAdd <- addItem
  pure ()

reflex-example-autocomplete.cabal

name:                reflex-example-autocomplete
version:             0.1.0.0
license:             BSD3
license-file:        LICENSE
author:              Dave Laing
maintainer:          [email protected]
build-type:          Simple
extra-source-files:  ChangeLog.md
cabal-version:       >=1.10

executable reflex-example-autocomplete
  main-is:             Main.hs
  build-depends:       base >=4.9 && <4.10
                     , lens
                     , text
                     , containers
                     , reflex
                     , reflex-dom
  hs-source-dirs:      src
  default-language:    Haskell2010

SimplerMain.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}
module Main (
    main
  ) where

import Control.Lens

import Data.Text (Text)
import qualified Data.Text as Text

import Data.Map (Map)
import qualified Data.Map as Map

import Data.Set (Set)
import qualified Data.Set as Set

import Reflex.Collection
import Reflex.Time

import Reflex.Dom

main ::
  IO ()
main =
  mainWidget exampleWidget

-- Adds items to the list
addItem ::
  MonadWidget t m =>
  m (Event t Text)
addItem = mdo
  -- We set up a text input
  ti <- textInput $ def
    -- that will get cleared when the user presses enter
    & textInputConfig_setValue .~ ("" <$ eAtEnter)

  let
    -- We want to look at the value of the text input ...
    dValue = ti ^. textInput_value

    -- ... when the user presses Enter ...
    eKeypress = ti ^. textInput_keypress
    isKey k   = (== k) . keyCodeLookup . fromIntegral
    eEnter    = ffilter (isKey Enter) eKeypress

    -- .. if the stripped text is not empty
    eAtEnter'  = Text.strip <$> current dValue <@ eEnter
    eAtEnter   = ffilter (not . Text.null) eAtEnter'

  -- Return the Event
  pure eAtEnter

-- Build up a list of items
itemList ::
  MonadWidget t m =>
  Event t Text ->              -- ^ the Event that fires when there is something to add
  m (Dynamic t [Text])         -- ^ the Dynamic list of entries
itemList eAdd = do
  -- Accumulate a Map, starting from empty ...
  dList <- foldDyn ($) [] $
    -- ... by inserting the values from eAdd into it every time it fires
    (\x xs -> xs ++ [x]) <$> eAdd

  -- For every item we have added ...
  _ <- el "ul" . simpleList dList $
         -- ... display the text of the item,
         el "li" . dynText

  -- Return the list
  pure dList

searchWidget ::
  MonadWidget t m =>
  Dynamic t [Text] -> -- ^ The Dynamic list of entries to search through
  m ()
searchWidget dListIn = do
  -- We set up a text input
  ti <- textInput def

  let
    -- We want to look at its value when the user types ...
    eValue'' = view textInput_input ti
    -- ... and then strip the output ...
    eValue' = fmap Text.strip eValue''

    -- ... and break it up into different Events depending on whether
    -- the text input does or doesn't have text in it
    eValueClear = ffilter (Text.null) eValue'
    eValueSet = ffilter (not . Text.null) eValue'

  -- We build a list of output results, which starts empty
  dListOut <- foldDyn ($) [] . mergeWith (.) $ [
             -- If there is text to search for, filter out the results
               (\xs t -> const $ filter (Text.isInfixOf t) xs) <$> current dListIn <@> eValueSet
             -- otherwise clear the results
             , const [] <$ eValueClear
             ]

  -- For every item in the results ...
  _ <- el "ul" . simpleList dListOut $
         -- ... display the text of the item ...
         el "li" . dynText

  pure ()

exampleWidget ::
  MonadWidget t m =>
  m ()
exampleWidget = mdo
  searchWidget dMap
  dMap <- itemList eAdd
  eAdd <- addItem
  pure ()