Fix scrolling in UI

Fix scrolling in UI

module Genetics.Browser.Track.UI where

import Prelude

import Control.Alt ((<|>))
import Control.Alternative (empty, (<*>))
import Control.Monad.Aff (Aff, launchAff)
import Control.Monad.Aff.AVar (makeVar, putVar, tryPeekVar)
import Control.Monad.Eff (Eff, foreachE)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (log)
import Control.Monad.Eff.Exception (error)
import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
import Control.Monad.Error.Class (throwError)
import DOM.HTML.Types (HTMLElement)
import Data.Argonaut (Json, _Array, _Number, _Object, _String)
import Data.Array (take, zip)
import Data.Array as Array
import Data.BigInt (BigInt)
import Data.BigInt as BigInt
import Data.Either (Either(..))
import Data.Filterable (class Filterable, filter, filterMap)
import Data.Filterable as Filterable
import Data.Foldable (class Foldable, foldMap, for_, length, maximum, maximumBy, sum)
import Data.Int (round)
import Data.Int as Int
import Data.Lens (_Left, view, (^?), (^.))
import Data.Lens.Index (ix)
import Data.List (List(..), (:))
import Data.List as List
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Monoid (mempty)
import Data.Newtype (ala, alaF, over, unwrap, wrap)
import Data.Nullable (Nullable, toMaybe)
import Data.Ord.Max (Max(..))
import Data.Pair (Pair(..))
import Data.Ratio (Ratio, (%))
import Data.Ratio as Ratio
import Data.Semigroup.Foldable (foldMap1)
import Data.Traversable (traverse, traverse_)
import Data.Tuple (Tuple(..), fst, snd)
import Debug.Trace (traceShow)
import Debug.Trace as Debug
import FRP.Event (Event)
import FRP.Event as Event
import FRP.Event as FRP
import Genetics.Browser.Track.Backend (GWASFeature, Gene, drawDemo, getDataDemo, mouseChrIds)
import Genetics.Browser.Types (Bp(..), ChrId(..), Point)
import Genetics.Browser.Types.Coordinates (BrowserPoint, CoordInterval, CoordSys(..), Interval, RelPoint, _BrowserSize, canvasToView, findBrowserInterval, intervalToGlobal, mkCoordSys, shiftIntervalBy)
import Genetics.Browser.View (Pixels)
import Global as Global
import Global.Unsafe (unsafeStringify)
import Graphics.Canvas (CanvasElement, Context2D, Transform, TranslateTransform, getCanvasElementById, getCanvasHeight, getContext2D, setCanvasWidth, transform, translate, withContext)
import Graphics.Drawing (Drawing, fillColor, filled, rectangle, white)
import Graphics.Drawing as Drawing
import Math as Math
import Network.HTTP.Affjax as Affjax
import Partial.Unsafe (unsafePartial)
import Unsafe.Coerce (unsafeCoerce)

foreign import getScreenSize :: forall eff. Eff eff { w :: Number, h :: Number }

-- 1st element is a backbuffer, 2nd the one shown on screen
foreign import scrollCanvas :: forall eff.
                               CanvasElement
                            -> CanvasElement
                            -> Point
                            -> Eff eff Unit

foreign import canvasDragImpl :: CanvasElement -> Event { during :: Nullable Point
                                                        , total :: Nullable Point }

-- creates a new CanvasElement, not attached to the DOM and thus not visible
foreign import newCanvas :: forall eff.
                            { w :: Number, h :: Number }
                         -> Eff eff CanvasElement

foreign import clearCanvas :: forall eff. CanvasElement -> Eff eff Unit

-- set an event to fire on the given button id
foreign import buttonEvent :: String
                           -> Event Unit

foreign import canvasEvent :: String -> CanvasElement -> Event Point

foreign import setViewUI :: forall eff. String -> Eff eff Unit

type BrowserView = Interval BrowserPoint

data UpdateView =
    Scroll BrowserPoint
  | Zoom (Ratio BigInt)
  | ScrollView (Ratio BigInt)
  | NoOp

btnScroll :: forall r.
             BrowserPoint
          -> Event UpdateView
btnScroll x = const (Scroll x) <$> buttonEvent "scrollLeft" <|>
              const (Scroll (negate x)) <$> buttonEvent "scrollRight"

btnZoom :: (Ratio BigInt)
        -> Event UpdateView
btnZoom m = const (Zoom (m )) <$> buttonEvent "zoomOut" <|>
            const (Zoom (m * (BigInt.fromInt 9 % BigInt.fromInt 100))) <$> buttonEvent "zoomIn"

btnUpdateView :: {scroll :: BrowserPoint, zoom :: Ratio BigInt } -> Event UpdateView
btnUpdateView  {scroll, zoom } = btnScroll scroll <|>
                                 btnZoom zoom <|>
                                 (const NoOp <$> buttonEvent "redraw")

scrollView :: CoordSys ChrId BrowserPoint
           -> BrowserPoint
           -> BrowserView
           -> BrowserView
scrollView cs p v = (_ - p) <$> v

scrollViewGood :: Ratio BigInt
               -> BrowserView
               -> BrowserView
scrollViewGood rat iv = iv `shiftIntervalBy` rat

-- zoomView :: BrowserPoint
--          -> Ratio BigInt
--          -> BrowserView
--          -> BrowserView
-- zoomView (BPoint size) p iv@(Interval (BPoint l) (BPoint r)) =
--   let len = r - l
--       len' = (len * (Ratio.numerator p)) / (Ratio.denominator p)
--   in (Interval (BPoint $ max zero (l + len')) (BPoint $ min size (r - len')))

normalizeView :: BrowserView
              -> BrowserView
              -> BrowserView
normalizeView (Pair lhs rhs)
              (Pair l   r) = Pair (max lhs l) (min r rhs)

updateViewFold :: CoordSys ChrId BrowserPoint
               -> UpdateView
               -> BrowserView
               -> BrowserView
-- updateViewFold _ iv = iv
updateViewFold cs uv iv@(Pair l r) = case uv of
  Scroll p  -> scrollView cs p iv
  -- Zoom r    -> zoomView ssz.size r iv
  ScrollView x -> scrollViewGood x iv
  _ -> iv

browserViewEvent :: CoordSys ChrId BrowserPoint
                 -> BrowserView
                 -> Event UpdateView
                 -> Event BrowserView
browserViewEvent cs start ev =
  Event.fold
    (\a b -> (normalizeView start) (updateViewFold cs a b)) ev start

drawingEvent :: { min :: Number, max :: Number }
             -> CoordSys ChrId BrowserPoint
             -> { width :: Pixels, height :: Pixels, yOffset :: Pixels }
             -> { gwas  :: Map ChrId (List _)
                , annots :: Map ChrId (List _) }
             -> Event BrowserView
             -> Event Drawing
drawingEvent s csys box dat = let dd = drawDemo csys s 0.25 box dat
                              in map dd

clickEvent :: forall r. CanvasElement -> Event Pixels
clickEvent el = (_.x) <$> canvasEvent "mousedown" el

viewClick :: forall r. { width :: Pixels | r} -> Event Pixels -> Event (Ratio BigInt)
viewClick w = map (canvasToView w)

globalClick :: Event (Interval BrowserPoint) -> Event (Ratio BigInt) -> Event BrowserPoint
globalClick vs vx = (\iv r -> intervalToGlobal iv r) <$> vs <*> vx

frameClick :: CoordSys ChrId BrowserPoint
           -> Event BrowserPoint
           -> Event (Maybe (CoordInterval _ _))
frameClick csys = map (findBrowserInterval csys)

chrClick :: CoordSys ChrId BrowserPoint
         -> Event (Maybe (CoordInterval _ _))
         -> Event (Maybe (Tuple ChrId Bp))
chrClick csys ev = (map <<< map) f $ ev
  where f {chrSize, index} = Tuple index chrSize

showView :: Interval BrowserPoint -> String
showView (Pair l r) = "< " <> BigInt.toString (unwrap l) <> " -- " <> BigInt.toString (unwrap r) <> " >"

showLP :: Interval BrowserPoint -> RelPoint -> String
showLP iv p = "Interval: " <> showView iv <> ";\t" <> show p

canvasDrag :: CanvasElement -> Event (Either Point Point)
canvasDrag el = f <$> canvasDragImpl el
  where f ev = case toMaybe ev.during of
          Just p  -> Right p
          Nothing -> Left $ unsafePartial $ fromJust (toMaybe ev.total)

browserDrag :: forall r.
               { width :: Number | r }
            -> Event Point
            -> Event (Ratio BigInt)
browserDrag w ev = f <$> ev
  where f :: _ -> _
        f {x} = let width = BigInt.fromInt $ Int.round w.width
                    x' = BigInt.fromInt $ Int.round x
                    p = x' % width
                in Debug.trace (show p) \_ -> p

scrollViewEvent :: Event (Ratio BigInt)
                -> Event UpdateView
scrollViewEvent = map ScrollView

main :: Eff _ _
main = launchAff do

  canvas <- liftEff $ unsafePartial $ fromJust <$> getCanvasElementById "canvas"
  ctx <- liftEff $ getContext2D canvas

  {w,h} <- liftEff do
    {w} <- getScreenSize
    h <- getCanvasHeight canvas
    _ <- setCanvasWidth (w-2.0) canvas
    pure {w, h}

  backCanvas <- liftEff $ newCanvas {w,h}

  let height = h
      offset = 0.0
      yInfo = { height, offset }

      chrIds = mouseChrIds

  let dragCanvasEv :: _
      dragCanvasEv = canvasDrag canvas

      browserDragEv :: Event (Ratio BigInt)
      browserDragEv = map negate $ browserDrag {width: w} (filterMap (_^?_Left) dragCanvasEv)

      dregs :: _
      dregs = scrollViewEvent browserDragEv

  let cs@(CoordSys s) = coordSys

      scroll :: BrowserPoint
      scroll = wrap $ BigInt.fromInt 10000000

      zoom :: Ratio BigInt
      zoom = one % (BigInt.fromInt 1000)

  let
      begin :: Interval BrowserPoint
      -- begin = Interval (BPoint $ BigInt.fromInt 652428823) (BPoint $ BigInt.fromInt 1829028329)
      -- begin = Pair (wrap $ BigInt.fromInt 652428823) s.size
      begin = Pair zero s.size

      viewEvent :: Event _
      viewEvent = browserViewEvent cs begin
                    $ btnUpdateView {scroll, zoom} <|> dregs

      click :: Event Pixels
      click = clickEvent canvas

      vClick :: Event (Ratio BigInt)
      vClick = viewClick {width: w} click

      gClick :: Event BrowserPoint
      gClick = globalClick viewEvent vClick

      fClick :: Event (Maybe _)
      fClick = frameClick cs gClick

      cClick :: Event (Maybe _)
      cClick = chrClick cs fClick

      clickEvs :: Event { view :: _
                        , canvasClick :: _
                        , vClick :: _
                        , gClick :: _
                        , fClick :: _
                        , cClick :: _ }
      clickEvs = { view: _, canvasClick: _, vClick: _
                 , gClick: _, fClick: _, cClick: _ }
                 <$> viewEvent <*> click <*> vClick
                 <*> gClick <*> fClick <*> cClick

  void $ liftEff $ unsafeCoerceEff $ FRP.subscribe dragCanvasEv $ case _ of
    Left _      -> pure unit
    Right {x,y} -> scrollCanvas backCanvas canvas {x: -x, y: 0.0}

  void $ liftEff $ Event.subscribe clickEvs
       (\ev -> do
           let sF (Just x) = "Frame: " <> show (unsafeStringify x)
               sF Nothing = "No Frame"
               sChr x = "Chr: " <> unsafeStringify x
               -- sChr (Just x) = "Chr: " <> show chr <> "\t" <> show (unwrap bp)
               -- sChr Nothing = "No Chr"

           setViewUI $ "
" <> showView ev.view <> "
"
                    <> "
" <> "Canvas click:" <> show ev.canvasClick <> "
"
                    <> "
" <> "View click:" <> show ev.vClick <> "
"
                    <> "
" <> "Global click:" <> show (unwrap ev.gClick) <> "
"
                    <> "
Frame click: " <> sF ev.fClick <> "
"
                    <> "
Chr click: " <> sChr ev.cClick <> "
"
           )

  dat <- getDataDemo { gwas: "./gwas.json"
                     , annots: "./annots_fake.json" }

  let sizes = {width: w, height: h, yOffset: 5.0}
      score = {min: 0.125, max: 0.42}

  let ev' = drawingEvent score cs sizes dat viewEvent
      bg = filled (fillColor white) $ rectangle 0.0 0.0 w h

  void $ liftEff $ Event.subscribe ev' (\d -> Drawing.render ctx (bg <> d))

coordSys :: _
coordSys = mkCoordSys mouseChrSizes (BigInt.fromInt 2000000)

mouseChrSizes :: Array (Tuple ChrId BigInt)
mouseChrSizes =
            [ Tuple (ChrId "1")   (unsafePartial $ fromJust $ BigInt.fromString "195471971")
            , Tuple (ChrId "2")   (unsafePartial $ fromJust $ BigInt.fromString "182113224")
            , Tuple (ChrId "3")   (unsafePartial $ fromJust $ BigInt.fromString "160039680")
            , Tuple (ChrId "4")   (unsafePartial $ fromJust $ BigInt.fromString "156508116")
            , Tuple (ChrId "5")   (unsafePartial $ fromJust $ BigInt.fromString "151834684")
            , Tuple (ChrId "6")   (unsafePartial $ fromJust $ BigInt.fromString "149736546")
            , Tuple (ChrId "7")   (unsafePartial $ fromJust $ BigInt.fromString "145441459")
            , Tuple (ChrId "8")   (unsafePartial $ fromJust $ BigInt.fromString "129401213")
            , Tuple (ChrId "9")   (unsafePartial $ fromJust $ BigInt.fromString "124595110")
            , Tuple (ChrId "10")  (unsafePartial $ fromJust $ BigInt.fromString "130694993")
            , Tuple (ChrId "11")  (unsafePartial $ fromJust $ BigInt.fromString "122082543")
            , Tuple (ChrId "12")  (unsafePartial $ fromJust $ BigInt.fromString "120129022")
            , Tuple (ChrId "13")  (unsafePartial $ fromJust $ BigInt.fromString "120421639")
            , Tuple (ChrId "14")  (unsafePartial $ fromJust $ BigInt.fromString "124902244")
            , Tuple (ChrId "15")  (unsafePartial $ fromJust $ BigInt.fromString "104043685")
            , Tuple (ChrId "16")  (unsafePartial $ fromJust $ BigInt.fromString "98207768")
            , Tuple (ChrId "17")  (unsafePartial $ fromJust $ BigInt.fromString "94987271")
            , Tuple (ChrId "18")  (unsafePartial $ fromJust $ BigInt.fromString "90702639")
            , Tuple (ChrId "19")  (unsafePartial $ fromJust $ BigInt.fromString "61431566")
            , Tuple (ChrId "X")   (unsafePartial $ fromJust $ BigInt.fromString "17103129")
            , Tuple (ChrId "Y")   (unsafePartial $ fromJust $ BigInt.fromString "9174469")
            ]

module Genetics.Browser.Track.UI where

import Prelude

import Control.Alt ((<|>))
import Control.Alternative (empty, (<*>))
import Control.Monad.Aff (Aff, launchAff)
import Control.Monad.Aff.AVar (makeVar, putVar, tryPeekVar)
import Control.Monad.Eff (Eff, foreachE)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (log)
import Control.Monad.Eff.Exception (error)
import Control.Monad.Eff.Unsafe (unsafeCoerceEff)
import Control.Monad.Error.Class (throwError)
import DOM.HTML.Types (HTMLElement)
import Data.Argonaut (Json, _Array, _Number, _Object, _String)
import Data.Array (take, zip)
import Data.Array as Array
import Data.BigInt (BigInt)
import Data.BigInt as BigInt
import Data.Either (Either(..))
import Data.Filterable (class Filterable, filter, filterMap)
import Data.Filterable as Filterable
import Data.Foldable (class Foldable, foldMap, for_, length, maximum, maximumBy, sum)
import Data.Int (round)
import Data.Int as Int
import Data.Lens (_Left, view, (^?), (^.))
import Data.Lens.Index (ix)
import Data.List (List(..), (:))
import Data.List as List
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Monoid (mempty)
import Data.Newtype (ala, alaF, over, unwrap, wrap)
import Data.Nullable (Nullable, toMaybe)
import Data.Ord.Max (Max(..))
import Data.Pair (Pair(..))
import Data.Ratio (Ratio, (%))
import Data.Ratio as Ratio
import Data.Semigroup.Foldable (foldMap1)
import Data.Traversable (traverse, traverse_)
import Data.Tuple (Tuple(..), fst, snd)
import Debug.Trace (traceShow)
import Debug.Trace as Debug
import FRP.Event (Event)
import FRP.Event as Event
import FRP.Event as FRP
import Genetics.Browser.Track.Backend (GWASFeature, Gene, drawDemo, getDataDemo, mouseChrIds)
import Genetics.Browser.Types (Bp(..), ChrId(..), Point)
import Genetics.Browser.Types.Coordinates (BrowserPoint, CoordInterval, CoordSys(..), Interval, RelPoint, _BrowserSize, canvasToView, findBrowserInterval, intervalToGlobal, mkCoordSys, shiftIntervalBy)
import Genetics.Browser.View (Pixels)
import Global as Global
import Global.Unsafe (unsafeStringify)
import Graphics.Canvas (CanvasElement, Context2D, Transform, TranslateTransform, getCanvasElementById, getCanvasHeight, getContext2D, setCanvasWidth, transform, translate, withContext)
import Graphics.Drawing (Drawing, fillColor, filled, rectangle, white)
import Graphics.Drawing as Drawing
import Math as Math
import Network.HTTP.Affjax as Affjax
import Partial.Unsafe (unsafePartial)
import Unsafe.Coerce (unsafeCoerce)

foreign import getScreenSize :: forall eff. Eff eff { w :: Number, h :: Number }

-- 1st element is a backbuffer, 2nd the one shown on screen
foreign import scrollCanvas :: forall eff.
                               CanvasElement
                            -> CanvasElement
                            -> Point
                            -> Eff eff Unit

foreign import canvasDragImpl :: CanvasElement -> Event { during :: Nullable Point
                                                        , total :: Nullable Point }

-- creates a new CanvasElement, not attached to the DOM and thus not visible
foreign import newCanvas :: forall eff.
                            { w :: Number, h :: Number }
                         -> Eff eff CanvasElement

foreign import clearCanvas :: forall eff. CanvasElement -> Eff eff Unit

-- set an event to fire on the given button id
foreign import buttonEvent :: String
                           -> Event Unit

foreign import canvasEvent :: String -> CanvasElement -> Event Point

foreign import setViewUI :: forall eff. String -> Eff eff Unit

type BrowserView = Interval BrowserPoint

data UpdateView =
    Scroll BrowserPoint
  | Zoom (Ratio BigInt)
  | ScrollView (Ratio BigInt)
  | NoOp

btnScroll :: forall r.
             BrowserPoint
          -> Event UpdateView
          --    BrowserPoint
          -- -> BrowserPoint
          -- -> Event UpdateView
btnScroll x = const (Scroll x) <$> buttonEvent "scrollLeft" <|>
              const (Scroll (negate x)) <$> buttonEvent "scrollRight"
-- btnScroll s (BPoint x) = scrollView s (wrap x)  <$> buttonEvent "scrollLeft"
                         -- const (scrollView s (wrap $ negate x)) <$> buttonEvent "scrollRight"

btnZoom :: (Ratio BigInt)
        -> Event UpdateView
btnZoom m = const (Zoom (m )) <$> buttonEvent "zoomOut" <|>
            const (Zoom (m * (BigInt.fromInt 9 % BigInt.fromInt 100))) <$> buttonEvent "zoomIn"

btnUpdateView :: {scroll :: BrowserPoint, zoom :: Ratio BigInt } -> Event UpdateView
-- btnUpdateView {scroll,zoom} = btnScroll scroll <|> btnZoom zoom <|> (const NoOp <$> buttonEvent "redraw")
btnUpdateView  {scroll, zoom } = btnScroll scroll <|>
                                 btnZoom zoom <|>
                                 (const NoOp <$> buttonEvent "redraw")
-- btnUpdateView = const NoOp <$> buttonEvent "redraw"

scrollView :: CoordSys ChrId BrowserPoint
           -> BrowserPoint
           -> BrowserView
           -> BrowserView
scrollView cs p v = (_ - p) <$> v
  -- let p' = p
  -- in Interval (BPoint $ max zero (l - p')) (BPoint $ min size (r - p'))

-- scrollViewRel :: CoordSys _ _
--               -> RelPoint
--               -> BrowserView
--               -> BrowserView
-- scrollViewRel p v

scrollViewGood :: Ratio BigInt
               -> BrowserView
               -> BrowserView
scrollViewGood rat iv = iv `shiftIntervalBy` rat

-- zoomView :: BrowserPoint
--          -> Ratio BigInt
--          -> BrowserView
--          -> BrowserView
-- zoomView (BPoint size) p iv@(Interval (BPoint l) (BPoint r)) =
--   let len = r - l
--       len' = (len * (Ratio.numerator p)) / (Ratio.denominator p)
--   in (Interval (BPoint $ max zero (l + len')) (BPoint $ min size (r - len')))

normalizeView :: BrowserView
              -> BrowserView
              -> BrowserView
normalizeView (Pair lhs rhs)
              -- (Pair l   r) = Pair (max lhs l) (min r rhs)
              (Pair l   r) = Pair l r

updateViewFold :: CoordSys ChrId BrowserPoint
               -> UpdateView
               -> BrowserView
               -> BrowserView
-- updateViewFold _ iv = iv
updateViewFold cs uv iv@(Pair l r) = case uv of
  Scroll p  -> scrollView cs p iv
  -- Zoom r    -> zoomView ssz.size r iv
  ScrollView x -> scrollViewGood x iv
  _ -> iv

browserViewEvent :: CoordSys ChrId BrowserPoint
                 -> BrowserView
                 -> Event UpdateView
                 -> Event BrowserView
browserViewEvent cs start ev =
  Event.fold
    (\a b -> (normalizeView start) (updateViewFold cs a b)) ev start

drawingEvent :: { min :: Number, max :: Number }
             -> CoordSys ChrId BrowserPoint
             -> { width :: Pixels, height :: Pixels, yOffset :: Pixels }
             -> { gwas  :: Map ChrId (List _)
                , annots :: Map ChrId (List _) }
             -> Event BrowserView
             -> Event Drawing
drawingEvent s csys box dat = let dd = drawDemo csys s 0.25 box dat
                              in map dd

clickEvent :: forall r. CanvasElement -> Event Pixels
clickEvent el = (_.x) <$> canvasEvent "mousedown" el

viewClick :: forall r. { width :: Pixels | r} -> Event Pixels -> Event (Ratio BigInt)
viewClick w = map (canvasToView w)

globalClick :: Event (Interval BrowserPoint) -> Event (Ratio BigInt) -> Event BrowserPoint
globalClick vs vx = (\iv r -> intervalToGlobal iv r) <$> vs <*> vx

frameClick :: CoordSys ChrId BrowserPoint
           -> Event BrowserPoint
           -> Event (Maybe (CoordInterval _ _))
frameClick csys = map (findBrowserInterval csys)

chrClick :: CoordSys ChrId BrowserPoint
         -> Event (Maybe (CoordInterval _ _))
         -> Event (Maybe (Tuple ChrId Bp))
chrClick csys ev = (map <<< map) f $ ev
  where f {chrSize, index} = Tuple index chrSize

showView :: Interval BrowserPoint -> String
showView (Pair l r) = "< " <> BigInt.toString (unwrap l) <> " -- " <> BigInt.toString (unwrap r) <> " >"

showLP :: Interval BrowserPoint -> RelPoint -> String
showLP iv p = "Interval: " <> showView iv <> ";\t" <> show p

canvasDrag :: CanvasElement -> Event (Either Point Point)
canvasDrag el = f <$> canvasDragImpl el
  where f ev = case toMaybe ev.during of
          Just p  -> Right p
          Nothing -> Left $ unsafePartial $ fromJust (toMaybe ev.total)

browserDrag :: forall r.
               { width :: Number | r }
            -> Event Point
            -> Event (Ratio BigInt)
browserDrag w ev = f <$> ev
  where f :: _ -> _
        f {x} = let width = BigInt.fromInt $ Int.round w.width
                    x' = BigInt.fromInt $ Int.round x
                    p = x' % width
                in Debug.trace (show p) \_ -> p

scrollViewEvent :: Event (Ratio BigInt)
                -> Event UpdateView
scrollViewEvent = map ScrollView

main :: Eff _ _
main = launchAff do

  canvas <- liftEff $ unsafePartial $ fromJust <$> getCanvasElementById "canvas"
  ctx <- liftEff $ getContext2D canvas

  {w,h} <- liftEff do
    {w} <- getScreenSize
    h <- getCanvasHeight canvas
    _ <- setCanvasWidth (w-2.0) canvas
    pure {w, h}

  backCanvas <- liftEff $ newCanvas {w,h}

  let height = h
      offset = 0.0
      yInfo = { height, offset }

      chrIds = mouseChrIds

  let dragCanvasEv :: _
      dragCanvasEv = canvasDrag canvas

      browserDragEv :: Event (Ratio BigInt)
      browserDragEv = browserDrag {width: w} (filterMap (_^?_Left) dragCanvasEv)

      dregs :: _
      dregs = scrollViewEvent browserDragEv

  let cs@(CoordSys s) = coordSys

      scroll :: BrowserPoint
      scroll = wrap $ BigInt.fromInt 10000000

      zoom :: Ratio BigInt
      zoom = one % (BigInt.fromInt 1000)

  let
      begin :: Interval BrowserPoint
      -- begin = Interval (BPoint $ BigInt.fromInt 652428823) (BPoint $ BigInt.fromInt 1829028329)
      -- begin = Pair (wrap $ BigInt.fromInt 652428823) s.size
      begin = Pair zero s.size

      viewEvent :: Event _
      viewEvent = browserViewEvent cs begin
                    $ btnUpdateView {scroll, zoom} <|> dregs

      click :: Event Pixels
      click = clickEvent canvas

      vClick :: Event (Ratio BigInt)
      vClick = viewClick {width: w} click

      gClick :: Event BrowserPoint
      gClick = globalClick viewEvent vClick

      fClick :: Event (Maybe _)
      fClick = frameClick cs gClick

      cClick :: Event (Maybe _)
      cClick = chrClick cs fClick

      clickEvs :: Event { view :: _
                        , canvasClick :: _
                        , vClick :: _
                        , gClick :: _
                        , fClick :: _
                        , cClick :: _ }
      clickEvs = { view: _, canvasClick: _, vClick: _
                 , gClick: _, fClick: _, cClick: _ }
                 <$> viewEvent <*> click <*> vClick
                 <*> gClick <*> fClick <*> cClick

  void $ liftEff $ unsafeCoerceEff $ FRP.subscribe dragCanvasEv $ case _ of
    Left _      -> pure unit
    Right {x,y} -> scrollCanvas backCanvas canvas {x: -x, y: 0.0}

  void $ liftEff $ Event.subscribe clickEvs
       (\ev -> do
           let sF (Just x) = "Frame: " <> show (unsafeStringify x)
               sF Nothing = "No Frame"
               sChr x = "Chr: " <> unsafeStringify x
               -- sChr (Just x) = "Chr: " <> show chr <> "\t" <> show (unwrap bp)
               -- sChr Nothing = "No Chr"

           setViewUI $ "
" <> showView ev.view <> "
"
                    <> "
" <> "Canvas click:" <> show ev.canvasClick <> "
"
                    <> "
" <> "View click:" <> show ev.vClick <> "
"
                    <> "
" <> "Global click:" <> show (unwrap ev.gClick) <> "
"
                    <> "
Frame click: " <> sF ev.fClick <> "
"
                    <> "
Chr click: " <> sChr ev.cClick <> "
"
           )

  dat <- getDataDemo { gwas: "./gwas.json"
                     , annots: "./annots_fake.json" }

  let sizes = {width: w, height: h, yOffset: 5.0}
      score = {min: 0.125, max: 0.42}

  let ev' = drawingEvent score cs sizes dat viewEvent
      bg = filled (fillColor white) $ rectangle 0.0 0.0 w h

  void $ liftEff $ Event.subscribe ev' (\d -> Drawing.render ctx (bg <> d))

coordSys :: _
coordSys = mkCoordSys mouseChrSizes (BigInt.fromInt 2000000)

mouseChrSizes :: Array (Tuple ChrId BigInt)
mouseChrSizes =
            [ Tuple (ChrId "1")   (unsafePartial $ fromJust $ BigInt.fromString "195471971")
            , Tuple (ChrId "2")   (unsafePartial $ fromJust $ BigInt.fromString "182113224")
            , Tuple (ChrId "3")   (unsafePartial $ fromJust $ BigInt.fromString "160039680")
            , Tuple (ChrId "4")   (unsafePartial $ fromJust $ BigInt.fromString "156508116")
            , Tuple (ChrId "5")   (unsafePartial $ fromJust $ BigInt.fromString "151834684")
            , Tuple (ChrId "6")   (unsafePartial $ fromJust $ BigInt.fromString "149736546")
            , Tuple (ChrId "7")   (unsafePartial $ fromJust $ BigInt.fromString "145441459")
            , Tuple (ChrId "8")   (unsafePartial $ fromJust $ BigInt.fromString "129401213")
            , Tuple (ChrId "9")   (unsafePartial $ fromJust $ BigInt.fromString "124595110")
            , Tuple (ChrId "10")  (unsafePartial $ fromJust $ BigInt.fromString "130694993")
            , Tuple (ChrId "11")  (unsafePartial $ fromJust $ BigInt.fromString "122082543")
            , Tuple (ChrId "12")  (unsafePartial $ fromJust $ BigInt.fromString "120129022")
            , Tuple (ChrId "13")  (unsafePartial $ fromJust $ BigInt.fromString "120421639")
            , Tuple (ChrId "14")  (unsafePartial $ fromJust $ BigInt.fromString "124902244")
            , Tuple (ChrId "15")  (unsafePartial $ fromJust $ BigInt.fromString "104043685")
            , Tuple (ChrId "16")  (unsafePartial $ fromJust $ BigInt.fromString "98207768")
            , Tuple (ChrId "17")  (unsafePartial $ fromJust $ BigInt.fromString "94987271")
            , Tuple (ChrId "18")  (unsafePartial $ fromJust $ BigInt.fromString "90702639")
            , Tuple (ChrId "19")  (unsafePartial $ fromJust $ BigInt.fromString "61431566")
            , Tuple (ChrId "X")   (unsafePartial $ fromJust $ BigInt.fromString "17103129")
            , Tuple (ChrId "Y")   (unsafePartial $ fromJust $ BigInt.fromString "9174469")
            ]


Add trivial IsForeign Foreign instance

Add trivial IsForeign Foreign instance

module Data.Foreign.Class
  ( IsForeign

  , read
  , readJSON
  , readWith
  , readProp
  ) where

import Data.Array (range, zipWith, length)
import Data.Foreign
import Data.Foreign.Index
import Data.Foreign.Null
import Data.Foreign.Undefined
import Data.Foreign.NullOrUndefined
import Data.Traversable (sequence)
import Data.Either

class IsForeign a where
  read :: Foreign -> F a

instance foreignIsForeign :: IsForeign Foreign where
  read f = return f

instance stringIsForeign :: IsForeign String where
  read = readString

instance booleanIsForeign :: IsForeign Boolean where
  read = readBoolean

instance numberIsForeign :: IsForeign Number where
  read = readNumber

instance arrayIsForeign :: (IsForeign a) => IsForeign [a] where
  read value = readArray value >>= readElements
    where
    readElements :: forall a. (IsForeign a) => [Foreign] -> F [a]
    readElements arr = sequence (zipWith readElement (range 0 (length arr)) arr)

    readElement :: forall a. (IsForeign a) => Number -> Foreign -> F [a]
    readElement i value = readWith (ErrorAtIndex i) value

instance nullIsForeign :: (IsForeign a) => IsForeign (Null a) where
  read = readNull read

instance undefinedIsForeign :: (IsForeign a) => IsForeign (Undefined a) where
  read = readUndefined read

instance nullOrUndefinedIsForeign :: (IsForeign a) => IsForeign (NullOrUndefined a) where
  read = readNullOrUndefined read

readJSON :: forall a. (IsForeign a) => String -> F a
readJSON json = parseJSON json >>= read

readWith :: forall a e. (IsForeign a) => (ForeignError -> e) -> Foreign -> Either e a
readWith f value = either (Left <<< f) Right (read value)

readProp :: forall a i. (IsForeign a, Index i) => i -> Foreign -> F a
readProp prop value = value ! prop >>= readWith (errorAt prop)

module Data.Foreign.Class
  ( IsForeign

  , read
  , readJSON
  , readWith
  , readProp
  ) where

import Data.Array (range, zipWith, length)
import Data.Foreign
import Data.Foreign.Index
import Data.Foreign.Null
import Data.Foreign.Undefined
import Data.Foreign.NullOrUndefined
import Data.Traversable (sequence)
import Data.Either

class IsForeign a where
  read :: Foreign -> F a

instance stringIsForeign :: IsForeign String where
  read = readString

instance booleanIsForeign :: IsForeign Boolean where
  read = readBoolean

instance numberIsForeign :: IsForeign Number where
  read = readNumber

instance arrayIsForeign :: (IsForeign a) => IsForeign [a] where
  read value = readArray value >>= readElements
    where
    readElements :: forall a. (IsForeign a) => [Foreign] -> F [a]
    readElements arr = sequence (zipWith readElement (range 0 (length arr)) arr)

    readElement :: forall a. (IsForeign a) => Number -> Foreign -> F [a]
    readElement i value = readWith (ErrorAtIndex i) value

instance nullIsForeign :: (IsForeign a) => IsForeign (Null a) where
  read = readNull read

instance undefinedIsForeign :: (IsForeign a) => IsForeign (Undefined a) where
  read = readUndefined read

instance nullOrUndefinedIsForeign :: (IsForeign a) => IsForeign (NullOrUndefined a) where
  read = readNullOrUndefined read

readJSON :: forall a. (IsForeign a) => String -> F a
readJSON json = parseJSON json >>= read

readWith :: forall a e. (IsForeign a) => (ForeignError -> e) -> Foreign -> Either e a
readWith f value = either (Left <<< f) Right (read value)

readProp :: forall a i. (IsForeign a, Index i) => i -> Foreign -> F a
readProp prop value = value ! prop >>= readWith (errorAt prop)


Sort the initial environment

Sort the initial environment

module Insect.Environment
  ( Environment
  , initialEnvironment
  ) where

import Data.StrMap (StrMap, fromFoldable)
import Data.Tuple (Tuple(..))

import Quantities (Quantity, e, pi, speedOfLight, gravitationalConstant,
                   planckConstant, ℏ, electronMass, electronCharge, µ0, ε0, µB,
                   α, protonMass, avogadroConstant, kB, g0)

-- | The environment consists of identifiers that are mapped to specific
-- | quantities.
type Environment = StrMap Quantity

-- | The initial environment contains a few useful mathematical and physical
-- | constants.
initialEnvironment ∷ Environment
initialEnvironment = fromFoldable
  [ Tuple "alpha"              α
  , Tuple "avogadroConstant"   avogadroConstant
  , Tuple "bohrMagneton"       µB
  , Tuple "boltzmannConstant"  kB
  , Tuple "c"                  speedOfLight
  , Tuple "e"                  e
  , Tuple "electricConstant"   ε0
  , Tuple "eps0"               ε0
  , Tuple "ε0"                 ε0
  , Tuple "electronCharge"     electronCharge
  , Tuple "elementaryCharge"   electronCharge
  , Tuple "electronMass"       electronMass
  , Tuple "G"                  gravitationalConstant
  , Tuple "g0"                 g0
  , Tuple "gravity"            g0
  , Tuple "hbar"               ℏ
  , Tuple "ℏ"                  ℏ
  , Tuple "k_B"                kB
  , Tuple "magneticConstant"   µ0
  , Tuple "mu0"                µ0
  , Tuple "µ0"                 µ0
  , Tuple "muB"                µB
  , Tuple "µ_B"                µB
  , Tuple "N_A"                avogadroConstant
  , Tuple "pi"                 pi
  , Tuple "π"                  pi
  , Tuple "planckConstant"     planckConstant
  , Tuple "protonMass"         protonMass
  , Tuple "speedOfLight"       speedOfLight
  ]

module Insect.Environment
  ( Environment
  , initialEnvironment
  ) where

import Data.StrMap (StrMap, fromFoldable)
import Data.Tuple (Tuple(..))

import Quantities (Quantity, e, pi, speedOfLight, gravitationalConstant,
                   planckConstant, ℏ, electronMass, electronCharge, µ0, ε0, µB,
                   α, protonMass, avogadroConstant, kB, g0)

-- | The environment consists of identifiers that are mapped to specific
-- | quantities.
type Environment = StrMap Quantity

-- | The initial environment contains a few useful mathematical and physical
-- | constants.
initialEnvironment ∷ Environment
initialEnvironment = fromFoldable
  [ Tuple "e"                  e
  , Tuple "pi"                 pi
  , Tuple "π"                  pi
  , Tuple "G"                  gravitationalConstant
  , Tuple "electronMass"       electronMass
  , Tuple "electronCharge"     electronCharge
  , Tuple "elementaryCharge"   electronCharge
  , Tuple "c"                  speedOfLight
  , Tuple "speedOfLight"       speedOfLight
  , Tuple "planckConstant"     planckConstant
  , Tuple "hbar"               ℏ
  , Tuple "ℏ"                  ℏ
  , Tuple "µ0"                 µ0
  , Tuple "mu0"                µ0
  , Tuple "magneticConstant"   µ0
  , Tuple "ε0"                 ε0
  , Tuple "eps0"               ε0
  , Tuple "electricConstant"   ε0
  , Tuple "bohrMagneton"       µB
  , Tuple "µ_B"                µB
  , Tuple "muB"                µB
  , Tuple "alpha"              α
  , Tuple "protonMass"         protonMass
  , Tuple "avogadroConstant"   avogadroConstant
  , Tuple "N_A"                avogadroConstant
  , Tuple "k_B"                kB
  , Tuple "boltzmannConstant"  kB
  , Tuple "g0"                 g0
  , Tuple "gravity"            g0
  ]


Change show errors link to a button

Change show errors link to a button

module View.Notebook.Cell (cell) where

import Control.Functor (($>))
import Controller.Notebook.Cell (requestCellContent)
import Controller.Notebook.Cell.Viz (insertViz)
import Data.Array (length, null)
import Data.Date (Date(), toEpochMilliseconds)
import Data.Function (on)
import Data.Maybe (Maybe(), maybe)
import Data.Time (Milliseconds(..), Seconds(..), toSeconds)
import Input.Notebook (Input(..))
import Model.Notebook
import Model.Notebook.Cell
import Model.Notebook.Port (Port(..))
import Number.Format (toFixed)
import Optic.Core ((^.), (%~), (..), is)

import View.Common
import View.Notebook.Cell.Ace (aceEditor)
import View.Notebook.Cell.Explore (exploreEditor, exploreOutput)
import View.Notebook.Cell.Search (searchOutput, searchEditor)
import View.Notebook.Cell.Viz (vizChoices, vizOutput)
import View.Notebook.Cell.Markdown (markdownOutput)
import View.Notebook.Cell.Query (queryOutput)
import View.Notebook.Common

import qualified Halogen.HTML as H
import qualified Halogen.HTML.Attributes as A
import qualified Halogen.HTML.Events as E
import qualified Halogen.HTML.Events.Forms as E
import qualified Halogen.HTML.Events.Handler as E
import qualified Halogen.HTML.Events.Monad as E
import qualified Halogen.Themes.Bootstrap3 as B
import qualified View.Css as VC

cell :: forall e. State -> Cell -> [HTML e]
cell notebook state =
  [ H.div [ A.classes [B.containerFluid, VC.notebookCell] ]
    [ controls state
    , editor state
    , statusBar notebook.tickDate state
    , output state
    , insertNextCell notebook state
    ]
  ]

controls :: forall e. Cell -> HTML e
controls state =
  row [ H.div [ A.classes [B.btnGroup, B.pullRight, VC.cellControls] ]
        [ H.button [ A.classes [B.btn]
                   , E.onClick $ E.input_ $ UpdateCell (state ^. _cellId) (_hiddenEditor %~ not)
                   ]
          [ H.text (if state ^. _hiddenEditor then "Show" else "Hide") ]
        , H.button [ A.classes [B.btn]
                   , E.onClick $ E.input_ $ TrashCell $ state ^. _cellId
                   ]
          [ H.text "Trash" ]
        ]
      ]

output :: forall e. Cell -> HTML e
output state =
   H.div [ A.classes $ [B.row, VC.cellOutput] ]
   $ renderOutput state

statusBar :: forall e. Maybe Date -> Cell -> HTML e
statusBar d state =
  row' (fadeWhen (state ^. _hiddenEditor))
  [ H.div [ A.classes [VC.cellEvalLine, B.clearfix] ]
    [ H.button [ A.classes [ B.btn
                           , B.btnPrimary
                           , if isRunning (state ^. _runState)
                             then VC.stopButton
                             else VC.playButton ]
               , E.onClick \_ -> if isRunning (state ^. _runState)
                                 then pure (pure (StopCell $ state ^. _cellId))
                                 else pure (requestCellContent state)
               ]
      [ if isRunning (state ^. _runState)
        then glyph B.glyphiconStop
        else glyph B.glyphiconPlay ]
    , H.div [ A.classes [ VC.statusText ] ]
      [ H.text $ statusText d (state ^. _runState) ]
    , H.div [ A.classes [ B.pullRight ] ]
      [ H.button [ A.classes [ B.btn
                             , B.glyphicon
                             , if state ^._expandedStatus
                               then B.glyphiconEyeClose
                               else B.glyphiconEyeOpen
                             ]
                 , E.onClick (\_ -> E.preventDefault $>
                                   pure (UpdateCell (state ^._cellId)
                                         (_expandedStatus %~ not)))
                 ]
                 [ ]
      ]
    , H.div [ A.classes [ VC.cellFailures ] ]
      (message state)
    ]
  ]

insertNextCell :: forall e. State -> Cell -> HTML e
insertNextCell notebook state = row
  [ H.div [ A.classes [ VC.cellEvalLine, B.clearfix ] ]
    [ H.button
      [ A.classes [ B.btn
                  , B.btnPrimary
                  , VC.playButton
                  ]
      , E.onClick $ E.input_ $ UpdateCell (state ^. _cellId) (_addingNextCell %~ not)
      ]
      [ glyph if state ^. _addingNextCell
              then B.glyphiconMenuLeft
              else B.glyphiconMenuRight ]
    , H.ul [ A.classes ([ B.listInline, VC.nextCellList ] <>
                        (fadeWhen $ not $ (state ^. _addingNextCell))) ]
      (nextCellChoices notebook state)
    ]
  ]
nextCellChoices :: forall e. State -> Cell -> [HTML e]
nextCellChoices notebook state =
  [ li "Query cell" newQueryContent  B.glyphiconHdd
  , li "Explore cell" newExploreContent B.glyphiconEyeOpen
  , li "Markdown cell" newMarkdownContent B.glyphiconEdit
  , li "Search cell" newSearchContent B.glyphiconSearch] <>
  case state ^. _output of
    PortResource _ ->
      [ H.li_ [ H.a [ A.href "#"
                  , E.onClick (\_ -> E.preventDefault $> insertViz notebook state)
                  , A.title "Visualization cell"
                  , A.classes [ B.btn ]
                  ]
              [ glyph B.glyphiconPicture ]
              ]
      ]
    _ -> [ ]

  where
  li :: String -> CellContent -> A.ClassName -> HTML e
  li title content c =
    H.li_ [ H.a [ A.href "#"
                , E.onClick \_ -> E.preventDefault $> pure (InsertCell state content)
                , A.title title
                , A.classes [ B.btn ] ] [ glyph c ] ]

message :: forall e. Cell -> [HTML e]
message cell =
  if null (cell ^._failures)
  then if (cell ^._message) /= ""
       then details cell
       else [ ]
  else failureText cell

details :: forall e. Cell -> [HTML e]
details cell = commonMessage "" [H.div_ [H.text (cell^._message)]] cell

failureText :: forall e. Cell -> [HTML e]
failureText cell =
  commonMessage
  (show (length fs) <> " error(s) during evaluation. ")
  ((\f -> H.div_ [H.text f]) <$> fs)
  cell
  where fs = cell ^._failures

commonMessage :: forall e. String -> [HTML e] -> Cell -> [HTML e]
commonMessage intro children cell =
  [ H.div_ [ H.text intro ]
  ] <>
  if (cell ^._expandedStatus)
  then children
  else [ ]

isRunning :: RunState -> Boolean
isRunning (RunningSince _) = true
isRunning _ = false

statusText :: Maybe Date -> RunState -> String
statusText _ RunInitial = ""
statusText d (RunningSince d') = maybe "" (\s -> "Running for " <> s <> "s") $ d >>= flip secondsText d'
statusText _ (RunFinished (Milliseconds ms)) = "Finished: took " <> show ms <> "ms."

secondsText :: Date -> Date -> Maybe String
secondsText a b = toFixed 0 <<< Math.max 0 <<< unSeconds $ on (-) (toSeconds <<< toEpochMilliseconds) a b
  where unSeconds (Seconds n) = n

editor :: forall e. Cell -> HTML e
editor state = case state ^. _content of
  (Explore rec) -> exploreEditor state
  (Search _) -> searchEditor state
  (Visualize _) -> vizChoices state
  _ -> aceEditor state

renderOutput :: forall e. Cell -> [HTML e]
renderOutput cell =
  if not (null $ cell ^. _failures)
  then []
  else case cell ^. _content of
    Explore _ -> exploreOutput cell
    Markdown s -> [markdownOutput s (cell ^. _cellId)]
    Search _ -> searchOutput cell
    Visualize _ -> vizOutput cell
    Query _ -> queryOutput cell
    _ -> []

module View.Notebook.Cell (cell) where

import Control.Functor (($>))
import Controller.Notebook.Cell (requestCellContent)
import Controller.Notebook.Cell.Viz (insertViz)
import Data.Array (length, null)
import Data.Date (Date(), toEpochMilliseconds)
import Data.Function (on)
import Data.Maybe (Maybe(), maybe)
import Data.Time (Milliseconds(..), Seconds(..), toSeconds)
import Input.Notebook (Input(..))
import Model.Notebook
import Model.Notebook.Cell
import Model.Notebook.Port (Port(..))
import Number.Format (toFixed)
import Optic.Core ((^.), (%~), (..), is)

import View.Common
import View.Notebook.Cell.Ace (aceEditor)
import View.Notebook.Cell.Explore (exploreEditor, exploreOutput)
import View.Notebook.Cell.Search (searchOutput, searchEditor)
import View.Notebook.Cell.Viz (vizChoices, vizOutput)
import View.Notebook.Cell.Markdown (markdownOutput)
import View.Notebook.Cell.Query (queryOutput)
import View.Notebook.Common

import qualified Halogen.HTML as H
import qualified Halogen.HTML.Attributes as A
import qualified Halogen.HTML.Events as E
import qualified Halogen.HTML.Events.Forms as E
import qualified Halogen.HTML.Events.Handler as E
import qualified Halogen.HTML.Events.Monad as E
import qualified Halogen.Themes.Bootstrap3 as B
import qualified View.Css as VC

cell :: forall e. State -> Cell -> [HTML e]
cell notebook state =
  [ H.div [ A.classes [B.containerFluid, VC.notebookCell] ]
    [ controls state
    , editor state
    , statusBar notebook.tickDate state
    , output state
    , insertNextCell notebook state
    ]
  ]

controls :: forall e. Cell -> HTML e
controls state =
  row [ H.div [ A.classes [B.btnGroup, B.pullRight, VC.cellControls] ]
        [ H.button [ A.classes [B.btn]
                   , E.onClick $ E.input_ $ UpdateCell (state ^. _cellId) (_hiddenEditor %~ not)
                   ]
          [ H.text (if state ^. _hiddenEditor then "Show" else "Hide") ]
        , H.button [ A.classes [B.btn]
                   , E.onClick $ E.input_ $ TrashCell $ state ^. _cellId
                   ]
          [ H.text "Trash" ]
        ]
      ]

output :: forall e. Cell -> HTML e
output state =
   H.div [ A.classes $ [B.row, VC.cellOutput] ]
   $ renderOutput state

statusBar :: forall e. Maybe Date -> Cell -> HTML e
statusBar d state =
  row' (fadeWhen (state ^. _hiddenEditor))
  [ H.div [ A.classes [VC.cellEvalLine, B.clearfix] ]
    [ H.button [ A.classes [ B.btn
                           , B.btnPrimary
                           , if isRunning (state ^. _runState)
                             then VC.stopButton
                             else VC.playButton ]
               , E.onClick \_ -> if isRunning (state ^. _runState)
                                 then pure (pure (StopCell $ state ^. _cellId))
                                 else pure (requestCellContent state)
               ]
      [ if isRunning (state ^. _runState)
        then glyph B.glyphiconStop
        else glyph B.glyphiconPlay ]
    , H.div [ A.classes [ VC.statusText ] ]
      [ H.text $ statusText d (state ^. _runState) ]
    , H.div [ A.classes [ VC.cellFailures ] ]
      (message state)
--      (failureText (state ^. _cellId) (state ^. _expandedStatus) (state ^. _failures))
    ]
  ]

insertNextCell :: forall e. State -> Cell -> HTML e
insertNextCell notebook state = row
  [ H.div [ A.classes [ VC.cellEvalLine, B.clearfix ] ]
    [ H.button
      [ A.classes [ B.btn
                  , B.btnPrimary
                  , VC.playButton
                  ]
      , E.onClick $ E.input_ $ UpdateCell (state ^. _cellId) (_addingNextCell %~ not)
      ]
      [ glyph if state ^. _addingNextCell
              then B.glyphiconMenuLeft
              else B.glyphiconMenuRight ]
    , H.ul [ A.classes ([ B.listInline, VC.nextCellList ] <>
                        (fadeWhen $ not $ (state ^. _addingNextCell))) ]
      (nextCellChoices notebook state)
    ]
  ]
nextCellChoices :: forall e. State -> Cell -> [HTML e]
nextCellChoices notebook state =
  [ li "Query cell" newQueryContent  B.glyphiconHdd
  , li "Explore cell" newExploreContent B.glyphiconEyeOpen
  , li "Markdown cell" newMarkdownContent B.glyphiconEdit
  , li "Search cell" newSearchContent B.glyphiconSearch] <>
  case state ^. _output of
    PortResource _ ->
      [ H.li_ [ H.a [ A.href "#"
                  , E.onClick (\_ -> E.preventDefault $> insertViz notebook state)
                  , A.title "Visualization cell"
                  , A.classes [ B.btn ]
                  ]
              [ glyph B.glyphiconPicture ]
              ]
      ]
    _ -> [ ]

  where
  li :: String -> CellContent -> A.ClassName -> HTML e
  li title content c =
    H.li_ [ H.a [ A.href "#"
                , E.onClick \_ -> E.preventDefault $> pure (InsertCell state content)
                , A.title title
                , A.classes [ B.btn ] ] [ glyph c ] ]

message :: forall e. Cell -> [HTML e]
message cell =
  if null (cell ^._failures)
  then if (cell ^._message) /= ""
       then details cell
       else [ ]
  else failureText cell

details :: forall e. Cell -> [HTML e]
details cell = commonMessage "" [H.div_ [H.text (cell^._message)]] cell

failureText :: forall e. Cell -> [HTML e]
failureText cell =
  commonMessage
  (show (length fs) <> " error(s) during evaluation. ")
  ((\f -> H.div_ [H.text f]) <$> fs)
  cell
  where fs = cell ^._failures

commonMessage :: forall e. String -> [HTML e] -> Cell -> [HTML e]
commonMessage intro children cell =
  [ H.div_
    [ H.text intro
    , H.a [ A.href "#"
          , E.onClick (\_ -> E.preventDefault $>
                            pure (UpdateCell (cell ^._cellId)
                                  (_expandedStatus %~ not)))
          ]
      (linkText (cell ^._expandedStatus))
    ]
  ] <>
  if (cell ^._expandedStatus)
  then children
  else [ ]

linkText :: forall e. Boolean -> [HTML e]
linkText expanded =
  [H.text (if expanded
           then "Hide details"
           else "Show details")
  ]

isRunning :: RunState -> Boolean
isRunning (RunningSince _) = true
isRunning _ = false

statusText :: Maybe Date -> RunState -> String
statusText _ RunInitial = ""
statusText d (RunningSince d') = maybe "" (\s -> "Running for " <> s <> "s") $ d >>= flip secondsText d'
statusText _ (RunFinished (Milliseconds ms)) = "Finished: took " <> show ms <> "ms."

secondsText :: Date -> Date -> Maybe String
secondsText a b = toFixed 0 <<< Math.max 0 <<< unSeconds $ on (-) (toSeconds <<< toEpochMilliseconds) a b
  where unSeconds (Seconds n) = n

editor :: forall e. Cell -> HTML e
editor state = case state ^. _content of
  (Explore rec) -> exploreEditor state
  (Search _) -> searchEditor state
  (Visualize _) -> vizChoices state
  _ -> aceEditor state

renderOutput :: forall e. Cell -> [HTML e]
renderOutput cell =
  if not (null $ cell ^. _failures)
  then []
  else case cell ^. _content of
    Explore _ -> exploreOutput cell
    Markdown s -> [markdownOutput s (cell ^. _cellId)]
    Search _ -> searchOutput cell
    Visualize _ -> vizOutput cell
    Query _ -> queryOutput cell
    _ -> []


Add toLocaleString etc

Add toLocaleString etc

module Data.Date.Locale
  ( Locale()
  , dateTime
  , date
  , year
  , month
  , dayOfMonth
  , dayOfWeek
  , hourOfDay
  , minuteOfHour
  , secondOfMinute
  , millisecondOfSecond
  , toLocaleString
  , toLocaleTimeString
  , toLocaleDateString
  ) where

import Control.Monad.Eff (Eff())
import Data.Date
import Data.Enum (fromEnum, toEnum)
import Data.Function (Fn2(), runFn2, Fn7(), runFn7)
import Data.Int (Int())
import Data.Maybe (Maybe())
import Data.Maybe.Unsafe (fromJust)
import Data.Time

-- | The effect of reading the current system locale/timezone.
foreign import data Locale :: !

-- | Attempts to create a `Date` from date and time components based on the
-- | current machine’s locale. `Nothing` is returned if the resulting date is
-- | invalid.
dateTime :: forall e. Year -> Month -> DayOfMonth
         -> HourOfDay -> MinuteOfHour -> SecondOfMinute -> MillisecondOfSecond
         -> Eff (locale :: Locale | e) (Maybe Date)
dateTime y mo d h mi s ms =
  fromJSDate <$> runFn7 jsDateFromValues y (fromEnum mo) d h mi s ms

-- | Attempts to create a `Date` from date components based on the current
-- | machine’s locale. `Nothing` is returned if the resulting date is invalid.
date :: forall e. Year -> Month -> DayOfMonth -> Eff (locale :: Locale | e) (Maybe Date)
date y m d = dateTime y m d (HourOfDay zero) (MinuteOfHour zero) (SecondOfMinute zero) (MillisecondOfSecond zero)

-- | Gets the year component for a date based on the current machine’s locale.
year :: forall e. Date -> Eff (locale :: Locale | e) Year
year d = runFn2 dateMethod "getFullYear" d

-- | Gets the month component for a date based on the current machine’s locale.
month :: forall e. Date -> Eff (locale :: Locale | e) Month
month d = fromJust <<< toEnum <$> runFn2 dateMethod "getMonth" d

-- | Gets the day-of-month value for a date based on the current machine’s
-- | locale.
dayOfMonth :: forall e. Date -> Eff (locale :: Locale | e) DayOfMonth
dayOfMonth d = runFn2 dateMethod "getDate" d

-- | Gets the day-of-week value for a date based on the current machine’s
-- | locale.
dayOfWeek :: forall e. Date -> Eff (locale :: Locale | e) DayOfWeek
dayOfWeek d = fromJust <<< toEnum <$> runFn2 dateMethod "getDay" d

-- | Gets the hour-of-day value for a date based on the current machine’s
-- | locale.
hourOfDay :: forall e. Date -> Eff (locale :: Locale | e) HourOfDay
hourOfDay d = runFn2 dateMethod "getHours" d

-- | Gets the minute-of-hour value for a date based on the current machine’s
-- | locale.
minuteOfHour :: forall e. Date -> Eff (locale :: Locale | e) MinuteOfHour
minuteOfHour d = runFn2 dateMethod "getMinutes" d

-- | Get the second-of-minute value for a date based on the current machine’s
-- | locale.
secondOfMinute :: forall e. Date -> Eff (locale :: Locale | e) SecondOfMinute
secondOfMinute d = runFn2 dateMethod "getSeconds" d

-- | Get the millisecond-of-second value for a date based on the current
-- | machine’s locale.
millisecondOfSecond :: forall e. Date -> Eff (locale :: Locale | e) MillisecondOfSecond
millisecondOfSecond d = runFn2 dateMethod "getMilliseconds" d

-- | Format a date as a human-readable string (including the date and the
-- | time), based on the current machine's locale. Example output:
-- | "Fri May 22 2015 19:45:07 GMT+0100 (BST)", although bear in mind that this
-- | can vary significantly across platforms.
toLocaleString :: forall e. Date -> Eff (locale :: Locale | e) String
toLocaleString d = runFn2 dateMethod "toLocaleString" d

-- | Format a time as a human-readable string, based on the current machine's
-- | locale. Example output: "19:45:07", although bear in mind that this
-- | can vary significantly across platforms.
toLocaleTimeString :: forall e. Date -> Eff (locale :: Locale | e) String
toLocaleTimeString d = runFn2 dateMethod "toLocaleTimeString" d

-- | Format a date as a human-readable string, based on the current machine's
-- | locale. Example output: "Friday, May 22, 2015", although bear in mind that
-- | this can vary significantly across platforms.
toLocaleDateString :: forall e. Date -> Eff (locale :: Locale | e) String
toLocaleDateString d = runFn2 dateMethod "toLocaleDateString" d

foreign import dateMethod
  """
  function dateMethod(method, date) {
    return function () {
      return date[method]();
    };
  }
  """ :: forall e a. Fn2 String Date (Eff (locale :: Locale | e) a)

foreign import jsDateFromValues
  """
  function jsDateFromValues(y, mo, d, h, mi, s, ms) {
    return function () {
      return new Date(y, mo, d, h, mi, s, ms);
    };
  }
  """ :: forall e. Fn7 Year Number DayOfMonth HourOfDay MinuteOfHour SecondOfMinute MillisecondOfSecond (Eff (locale :: Locale | e) JSDate)

module Data.Date.Locale
  ( Locale()
  , dateTime
  , date
  , year
  , month
  , dayOfMonth
  , dayOfWeek
  , hourOfDay
  , minuteOfHour
  , secondOfMinute
  , millisecondOfSecond
  ) where

import Control.Monad.Eff (Eff())
import Data.Date
import Data.Enum (fromEnum, toEnum)
import Data.Function (Fn2(), runFn2, Fn7(), runFn7)
import Data.Int (Int())
import Data.Maybe (Maybe())
import Data.Maybe.Unsafe (fromJust)
import Data.Time

-- | The effect of reading the current system locale/timezone.
foreign import data Locale :: !

-- | Attempts to create a `Date` from date and time components based on the
-- | current machine’s locale. `Nothing` is returned if the resulting date is
-- | invalid.
dateTime :: forall e. Year -> Month -> DayOfMonth
         -> HourOfDay -> MinuteOfHour -> SecondOfMinute -> MillisecondOfSecond
         -> Eff (locale :: Locale | e) (Maybe Date)
dateTime y mo d h mi s ms =
  fromJSDate <$> runFn7 jsDateFromValues y (fromEnum mo) d h mi s ms

-- | Attempts to create a `Date` from date components based on the current
-- | machine’s locale. `Nothing` is returned if the resulting date is invalid.
date :: forall e. Year -> Month -> DayOfMonth -> Eff (locale :: Locale | e) (Maybe Date)
date y m d = dateTime y m d (HourOfDay zero) (MinuteOfHour zero) (SecondOfMinute zero) (MillisecondOfSecond zero)

-- | Gets the year component for a date based on the current machine’s locale.
year :: forall e. Date -> Eff (locale :: Locale | e) Year
year d = runFn2 dateMethod "getFullYear" d

-- | Gets the month component for a date based on the current machine’s locale.
month :: forall e. Date -> Eff (locale :: Locale | e) Month
month d = fromJust <<< toEnum <$> runFn2 dateMethod "getMonth" d

-- | Gets the day-of-month value for a date based on the current machine’s
-- | locale.
dayOfMonth :: forall e. Date -> Eff (locale :: Locale | e) DayOfMonth
dayOfMonth d = runFn2 dateMethod "getDate" d

-- | Gets the day-of-week value for a date based on the current machine’s
-- | locale.
dayOfWeek :: forall e. Date -> Eff (locale :: Locale | e) DayOfWeek
dayOfWeek d = fromJust <<< toEnum <$> runFn2 dateMethod "getDay" d

-- | Gets the hour-of-day value for a date based on the current machine’s
-- | locale.
hourOfDay :: forall e. Date -> Eff (locale :: Locale | e) HourOfDay
hourOfDay d = runFn2 dateMethod "getHours" d

-- | Gets the minute-of-hour value for a date based on the current machine’s
-- | locale.
minuteOfHour :: forall e. Date -> Eff (locale :: Locale | e) MinuteOfHour
minuteOfHour d = runFn2 dateMethod "getMinutes" d

-- | Get the second-of-minute value for a date based on the current machine’s
-- | locale.
secondOfMinute :: forall e. Date -> Eff (locale :: Locale | e) SecondOfMinute
secondOfMinute d = runFn2 dateMethod "getSeconds" d

-- | Get the millisecond-of-second value for a date based on the current
-- | machine’s locale.
millisecondOfSecond :: forall e. Date -> Eff (locale :: Locale | e) MillisecondOfSecond
millisecondOfSecond d = runFn2 dateMethod "getMilliseconds" d

foreign import dateMethod
  """
  function dateMethod(method, date) {
    return function () {
      return date[method]();
    };
  }
  """ :: forall e a. Fn2 String Date (Eff (locale :: Locale | e) a)

foreign import jsDateFromValues
  """
  function jsDateFromValues(y, mo, d, h, mi, s, ms) {
    return function () {
      return new Date(y, mo, d, h, mi, s, ms);
    };
  }
  """ :: forall e. Fn7 Year Number DayOfMonth HourOfDay MinuteOfHour SecondOfMinute MillisecondOfSecond (Eff (locale :: Locale | e) JSDate)