WIP on explorer

editor/default.nix

@@ -1,5 +1,6 @@
-{ mkDerivation, base, free, ghcjs-dom, ghcjs-base, mtl, reflex, reflex-dom, 
-  semigroups, stdenv, text, transformers, unison-shared }:
+{ mkDerivation, base, containers, data-default, free, ghcjs-dom, 
+  ghcjs-base, mtl, reflex, reflex-dom, semigroups, stdenv, text, 
+  transformers, unison-shared }:
 mkDerivation {
   pname = "unison-editor";
   version = "0.1";

editor/src/Editor.hs

@@ -38,7 +38,7 @@ main = mainWidget $ do
   let firstName (Metadata.Names (n:_)) = n
   let lookupSymbol ref = maybe (defaultSymbol ref) (firstName . Metadata.names) (Map.lookup ref symbols)
   let termDoc = view lookupSymbol term
-  (e, dims, path) <- elAttr "div" (Map.fromList [("class","root")]) $ DocView.widget keydown (Width 300) termDoc
+  (e, dims, path) <- elClass "div" "root" $ DocView.widget keydown (Width 300) termDoc
   highlightedType <- holdDyn (Type.v' "..") =<< dyn =<< mapDyn (liftIO . Note.run . Node.typeAt node term) path
   el "div" $ do
      text "type: "

editor/src/Unison/DocView.hs

@@ -67,10 +67,10 @@ widget keydown available d =
     (e,_) <- elAttr' "div" attrs $ unsafePlaceElement (Dom.unsafeAsHTMLElement node)
     mouse <- UI.mouseMove' e
     nav <- pure $ mergeWith (.) [
-      const (Doc.up b) <$> (traceEvent "up" $ ffilter (== 38) keydown),
-      const (Doc.down b) <$> (traceEvent "down" $ ffilter (== 40) keydown),
-      const (Doc.left b) <$> (traceEvent "left" $ ffilter (== 37) keydown),
-      const (Doc.right b) <$> (traceEvent "right" $ ffilter (== 39) keydown),
+      const (Doc.up b) <$> (traceEvent "up" $ S.upArrow keydown),
+      const (Doc.down b) <$> (traceEvent "down" $ S.downArrow keydown),
+      const (Doc.left b) <$> (traceEvent "left" $ S.leftArrow keydown),
+      const (Doc.right b) <$> (traceEvent "right" $ S.rightArrow keydown),
       const (Doc.up b) <$> (traceEvent "up" $ ffilter (== 75) keydown), -- k
       const (Doc.down b) <$> (traceEvent "down" $ ffilter (== 74) keydown), -- j
       const (Doc.left b) <$> (traceEvent "left" $ ffilter (== 72) keydown), -- h

editor/src/Unison/Explorer.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE RecursiveDo #-}
+
+module Unison.Explorer where
+
+import Data.Semigroup
+import Control.Monad.Fix
+import Reflex.Dom
+import Data.Default (def)
+import Unison.Dimensions (X(..),Y(..))
+import qualified Unison.Signals as Signals
+
+sum0 :: (Reflex t, MonadHold t m, MonadFix m) => Event t Int -> m (Dynamic t Int)
+sum0 s = mdo
+  a <- holdDyn 0 (pushAlways (\x -> (x+) <$> (sample $ current a)) s)
+  pure a
+
+explorer :: (Reflex t, MonadWidget t m, Eq k, Semigroup s)
+         => Event t Int
+         -- -> take in a m (), for stuff that is loaded asynchronously on open of explorer
+         -> (s -> String -> Action (m s) (k, m a))
+         -> Dynamic t s
+         -> m (Dynamic t (Maybe a, s))
+explorer keydown processQuery s0 =
+  let
+    extractReq a = case a of Request r _ -> Just r; _ -> Nothing
+    view list ind = do
+      -- e <- holdDyn 0 never -- todo
+      pure never
+  in
+    elClass "div" "explorer" $ mdo
+      searchbox <- textInput def
+      elClass "div" "top-separator" $ pure ()
+      s <- sample (current s0)
+      s' <- foldDyn (<>) s (updated responses)
+      actions <- pure $
+        pushAlways (\txt -> processQuery <$> sample (current s') <*> pure txt)
+                   (updated $ _textInput_value searchbox)
+      responses <- widgetHold (pure s) $ fmapMaybe extractReq actions
+      list <- holdDyn [] $
+        let
+          f a = case a of
+            Request _ l -> Just l
+            Results l -> Just l
+            _ -> Nothing
+        in
+          fmapMaybe f actions
+      selectable <- widgetHold (pure []) $ fmap (traverse snd) (updated list)
+      selectionIndex <- do
+        let mouse = fmap (\i _ -> pure i) mouseEvent
+        let nav f i l = if f i < length l && f i > 0 then f i else i
+        let up = fmap (\_ i -> nav (-1+) i <$> sample (current list)) $ Signals.upArrow keydown
+        let down = fmap (\_ i -> nav (1+) i <$> sample (current list)) $ Signals.downArrow keydown
+        foldDynM ($) 0 $ mergeWith (\f g x -> g x >>= f) [mouse, up, down] --, newResults]
+      mouseEvent <- elClass "div" "results" $
+        let f list = view list <$> sample (current selectionIndex)
+        in do
+          phases <- widgetHold (pure never) $ pushAlways f (updated list)
+          switchPromptly never (updated phases)
+      let safeIndex i l = if i < length l then Just (l !! i) else Nothing
+      selection <- combineDyn safeIndex selectionIndex selectable
+      combineDyn (,) selection s'
+
+data Action r a
+  = Request r [a]
+  | Results [a]
+  | Cancel
+  | Accept a
+
+-- let enter = textInputGetEnter searchbox

editor/src/Unison/Signals.hs

@@ -12,11 +12,8 @@ mergeThese a b = mergeWith g [fmap This a, fmap That b] where
 mergeLeft :: Reflex t => Event t a -> Event t b -> Event t (Either a b)
 mergeLeft a b = mergeWith const [fmap Left a, fmap Right b]
 
-keypress :: Reflex t => El t -> Event t Int
-keypress e = domEvent Keypress e
-
-upKeypress, downKeypress, leftKeypress, rightKeypress :: Reflex t => El t -> Event t Int
-leftKeypress e  = ffilter (== 37) (keypress e)
-upKeypress e    = ffilter (== 38) (keypress e)
-rightKeypress e = ffilter (== 39) (keypress e)
-downKeypress e  = ffilter (== 40) (keypress e)
+upArrow, downArrow, leftArrow, rightArrow :: Reflex t => Event t Int -> Event t Int
+leftArrow = ffilter (== 37)
+upArrow = ffilter (== 38)
+rightArrow = ffilter (== 39)
+downArrow = ffilter (== 40)

editor/unison-editor.cabal

@@ -47,12 +47,14 @@ library
   exposed-modules:
     Unison.DocView
     Unison.Dom
+    Unison.Explorer
     Unison.HTML
     Unison.UI
 
   build-depends:
     base,
     containers,
+    data-default,
     free,
     ghcjs-dom,
     ghcjs-base,
@@ -84,6 +86,7 @@ executable editor
   build-depends:
     base,
     containers,
+    data-default,
     free,
     ghcjs-dom,
     ghcjs-base,