Skip to content

Instantly share code, notes, and snippets.

@aratama

aratama/suggestion.purs

Last active Feb 11, 2016
Embed
What would you like to do?
module Throttle where
import Prelude (Unit(), unit, pure, ($), (<$>), (<#>), bind, void, (++), (==))
import Global (encodeURIComponent)
import Data.Maybe (Maybe(..))
import Data.Array ((!!))
import Data.Traversable (for)
import Data.Functor ((<$))
import Data.Date (Now(), nowEpochMilliseconds)
import Data.Time (Milliseconds(Milliseconds))
import Control.Monad (when)
import Control.Monad.Aff (Aff(), runAff, makeAff)
import Control.Monad.Eff (Eff())
import Control.Monad.Eff.Exception (Error(), throwException)
import Halogen (HalogenEffects(), ComponentDSL(), Natural(), ComponentHTML(), Component(), runUI, component, get, modify, liftEff', liftAff')
import Halogen.Util (appendToBody, onLoad)
import Halogen.HTML.Core (className)
import Halogen.HTML.Indexed (text, div, span, a, input)
import Halogen.HTML.Events.Indexed (onValueInput)
import Halogen.HTML.Properties.Indexed (href, class_, placeholder)
import Data.Argonaut.Core (Json(), toArray, toString)
import DOM (DOM())
import DOM.Timer (Timer(), timeout)
foreign import _jsonp :: forall eff . String -> String -> (Error -> Eff (dom :: DOM | eff) Unit) -> (Json -> Eff (dom :: DOM | eff) Unit) -> Eff (dom :: DOM | eff) Unit
jsonp :: forall eff . String -> String -> Aff (dom :: DOM | eff) Json
jsonp callback url = makeAff (_jsonp callback url)
parse :: Json -> Maybe (Array String)
parse json = do
xs <- toArray json
ys <- xs !! 1
entries <- toArray ys
for entries \r -> do
m <- toArray r
s <- m !! 0
toString s
throttle :: forall a f eff
. Int
-> ComponentDSL { inputTime :: Milliseconds | a } f (Aff (HalogenEffects (timer :: Timer, now :: Now | eff))) Unit
-> ComponentDSL { inputTime :: Milliseconds | a } f (Aff (HalogenEffects (timer :: Timer, now :: Now | eff))) Unit
throttle span action = do
inputTime <- liftEff' nowEpochMilliseconds
modify _ { inputTime = inputTime }
liftAff' $ sleep span
inputTime' <- get <#> _.inputTime
when (inputTime' == inputTime) action
sleep :: forall eff . Int -> Aff (timer :: Timer | eff) Unit
sleep milliseconds = makeAff \reject resolve -> void $ timeout milliseconds (resolve unit)
data FetchState = Initialized | OnInput | Fetching String | Complete (Maybe (Array String))
type State = { inputTime :: Milliseconds, fetch :: FetchState }
data Query a = Input String a
type Effects = HalogenEffects (timer :: Timer, now:: Now)
ui :: Component State Query (Aff Effects)
ui = component render eval
where
render :: State -> ComponentHTML Query
render s = div [class_ (className "outer")] [
div [class_ (className "title")] [
span [class_ (className "glyphicon glyphicon-search")] [],
text "Google Suggest Tool"
],
div [] [input [onValueInput (Halogen.HTML.Events.Indexed.input Input), placeholder "input some queries..."]],
div [] case s.fetch of
Initialized -> [text "(Initialized)"]
OnInput -> [text "(On Input ...)"]
Fetching token -> [text token]
Complete (Just xs) -> (\s -> div [] [a [href ("https://www.google.co.jp/search?q=" ++ s)] [text s]]) <$> xs
Complete Nothing -> [text "(Error)"]
]
eval :: Natural Query (ComponentDSL State Query (Aff Effects))
eval (Input str next) = next <$ do
modify _ { fetch = OnInput }
throttle 1000 do -- 1秒間入力がなくなるまで以降の処理を待機する
modify _ { fetch = Fetching str }
res <- liftAff' $ jsonp "suggestCallBack" ("http://www.google.com/complete/search?hl=en&jsonp=suggestCallBack&client=youtube&q=" ++ encodeURIComponent str)
modify _ { fetch = Complete (parse res) }
main :: Eff Effects Unit
main = runAff throwException pure $ void do
app <- runUI ui { inputTime: Milliseconds 0.0, fetch: Initialized }
onLoad $ appendToBody app.node
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.