Pass onChange object to purescript

Pass onChange object to purescript

module Ace.EditSession
  ( DynamicMarker
  , addDynamicMarker
  , addFold
  , addGutterDecoration
  , addMarker
  , adjustWrapLimit
  , clearAnnotations
  , clearBreakpoint
  , clearBreakpoints
  , createWithMode
  , createFromLines
  , create
  , detectNewLine
  , documentToScreenColumn
  , documentToScreenPosition
  , documentToScreenRow
  , duplicateLines
  , findMatchingBracket
  , getAWordRange
  , getAnnotations
  , getBackgroundTokenizer
  , getBreakpoints
  , getDisplayTokens
  , getDocument
  , getDocumentLastRowColumn
  , getDocumentLastRowColumnPosition
  , getLength
  , getLine
  , getLines
  , getMode
  , getNewLineMode
  , getOverwrite
  , getRowLength
  , getRowSplitData
  , getScreenLastRowColumn
  , getScreenLength
  , getScreenTabSize
  , getScreenWidth
  , getScrollLeft
  , getScrollTop
  , getSelection
  , getState
  , getStringScreenWidth
  , getTabSize
  , getTabString
  , getTextRange
  , getTokenAt
  , getTokens
  , getUndoManager
  , getUseSoftTabs
  , getUseWorker
  , getUseWrapMode
  , getValue
  , getWordRange
  , getWrapLimit
  , getWrapLimitRange
  , highlight
  , indentRows
  , insert
  , isTabStop
  , mode
  , moveLinesDown
  , moveLinesUp
  , moveText
  , onChange
  , onChangeAnnotation
  , onChangeBackMarker
  , onChangeBreakpoint
  , onChangeFold
  , onChangeFrontMarker
  , onChangeMode
  , onChangeOverwrite
  , onChangeScrollLeft
  , onChangeScrollTop
  , onChangeTabSize
  , onChangeWrapLimit
  , onChangeWrapMode
  , onTokenizerUpdate
  , onReloadTokenizer
  , outdentRows
  , remove
  , removeGutterDecoration
  , removeMarker
  , replace
  , resetRowCache
  , screenToDocumentColumn
  , screenToDocumentPosition
  , setAnnotations
  , setBreakpoint
  , setBreakpoints
  , setDocument
  , setMode
  , setNewLineMode
  , setOverwrite
  , setScrollLeft
  , setScrollTop
  , setTabSize
  , setUndoManager
  , setUndoSelect
  , setUseSoftTabs
  , setUseWorker
  , setUseWrapMode
  , setValue
  , setWrapLimitRange
  , toggleOverwrite
  , getMarkers
  ) where

import Prelude

import Ace.Types (Marker, EditSession, TextMode, Position, Range, Annotation, UndoManager, TokenInfo, Selection, Document, BackgroundTokenizer)
import Control.Monad.ST (ST)
import Data.Array.ST (STArray)
import Data.Function.Uncurried (Fn2, runFn2, Fn3, runFn3, Fn4, runFn4, Fn5, runFn5)
import Data.Maybe (Maybe)
import Data.Nullable (Nullable, toNullable)
import Effect (Effect)
import Web.HTML.HTMLElement (HTMLElement)

foreign import getBackgroundTokenizer :: EditSession -> Effect BackgroundTokenizer

foreign import onImpl :: forall ev a. Fn3 String (ev -> Effect a) EditSession (Effect Unit)

onChange :: forall a. EditSession -> ({ action :: String, start :: { row :: Int, column :: Int }, end :: { row :: Int, column :: Int }, lines :: Array String } -> Effect a) -> Effect Unit
onChange self fn = runFn3 onImpl "change" fn self

onChangeAnnotation :: forall a. EditSession -> Effect a -> Effect Unit
onChangeAnnotation self fn = runFn3 onImpl "changeAnnotation" (\_ -> fn) self

onChangeBackMarker :: forall a. EditSession -> Effect a -> Effect Unit
onChangeBackMarker self fn = runFn3 onImpl "changeBackMarker" (\_ -> fn) self

onChangeBreakpoint :: forall a. EditSession -> Effect a -> Effect Unit
onChangeBreakpoint self fn = runFn3 onImpl "changeBreakpoint" (\_ -> fn) self

onChangeFold :: forall a. EditSession -> Effect a -> Effect Unit
onChangeFold self fn = runFn3 onImpl "changeFold" (\_ -> fn) self

onChangeFrontMarker :: forall a. EditSession -> Effect a -> Effect Unit
onChangeFrontMarker self fn = runFn3 onImpl "changeFrontMarker" (\_ -> fn) self

onChangeMode :: forall a. EditSession -> Effect a -> Effect Unit
onChangeMode self fn = runFn3 onImpl "changeMode" (\_ -> fn) self

onChangeOverwrite :: forall a. EditSession -> Effect a -> Effect Unit
onChangeOverwrite self fn = runFn3 onImpl "changeOverwrite" (\_ -> fn) self

onChangeScrollLeft :: forall a. EditSession -> (Int -> Effect a) -> Effect Unit
onChangeScrollLeft self fn = runFn3 onImpl "changeScrollLeft" fn self

onChangeScrollTop :: forall a. EditSession -> (Int -> Effect a) -> Effect Unit
onChangeScrollTop self fn = runFn3 onImpl "changeScrollTop" fn self

onChangeTabSize :: forall a. EditSession -> Effect a -> Effect Unit
onChangeTabSize self fn = runFn3 onImpl "changeTabSize" (\_ -> fn) self

onChangeWrapLimit :: forall a. EditSession -> Effect a -> Effect Unit
onChangeWrapLimit self fn = runFn3 onImpl "changeWrapLimit" (\_ -> fn) self

onChangeWrapMode :: forall a. EditSession -> Effect a -> Effect Unit
onChangeWrapMode self fn = runFn3 onImpl "changeWrapMode" (\_ -> fn) self

onTokenizerUpdate :: forall a. EditSession -> Effect a -> Effect Unit
onTokenizerUpdate self fn = runFn3 onImpl "tokenizerUpdate" (\_ -> fn) self

foreign import findMatchingBracketImpl :: Fn2 Position EditSession (Effect Unit)

findMatchingBracket :: Position -> EditSession -> Effect Unit
findMatchingBracket position self = runFn2 findMatchingBracketImpl position self

foreign import addFoldImpl :: Fn3 String Range EditSession (Effect Unit)

addFold :: String -> Range -> EditSession -> Effect Unit
addFold text range self = runFn3 addFoldImpl text range self

foreign import screenToDocumentColumnImpl :: Fn3 Int Int EditSession (Effect Unit)

screenToDocumentColumn :: Int -> Int -> EditSession -> Effect Unit
screenToDocumentColumn row column self = runFn3 screenToDocumentColumnImpl row column self

foreign import highlightImpl :: Fn2 String EditSession (Effect Unit)

highlight :: String -> EditSession -> Effect Unit
highlight text self = runFn2 highlightImpl text self

foreign import setDocumentImpl :: Fn2 Document EditSession (Effect Unit)

setDocument :: Document -> EditSession -> Effect Unit
setDocument doc self = runFn2 setDocumentImpl doc self

foreign import getDocument :: EditSession -> Effect Document

foreign import resetRowCacheImpl :: Fn2 Int EditSession (Effect Unit)

resetRowCache :: Int -> EditSession -> Effect Unit
resetRowCache row self = runFn2 resetRowCacheImpl row self

foreign import setValueImpl :: Fn2 String EditSession (Effect Unit)

setValue :: String -> EditSession -> Effect Unit
setValue text self = runFn2 setValueImpl text self

foreign import setModeImpl :: Fn2 String EditSession (Effect Unit)

setMode :: String -> EditSession -> Effect Unit
setMode mode' self = runFn2 setModeImpl mode' self

foreign import getValue :: EditSession -> Effect String

foreign import getSelection :: EditSession -> Effect Selection

foreign import getStateImpl :: Fn2 Int EditSession (Effect String)

getState :: Int -> EditSession -> Effect String
getState row self = runFn2 getStateImpl row self

foreign import getTokensImpl :: Fn2 Int EditSession (Effect (Array TokenInfo))

getTokens :: Int -> EditSession -> Effect (Array TokenInfo)
getTokens row self = runFn2 getTokensImpl row self

foreign import getTokenAtImpl :: Fn3 Int Int EditSession (Effect TokenInfo)

getTokenAt :: Int -> Int -> EditSession -> Effect TokenInfo
getTokenAt row column self = runFn3 getTokenAtImpl row column self

foreign import setUndoManagerImpl :: Fn2 UndoManager EditSession (Effect Unit)

setUndoManager :: UndoManager -> EditSession -> Effect Unit
setUndoManager undoManager self = runFn2 setUndoManagerImpl undoManager self

foreign import getUndoManager :: EditSession -> Effect UndoManager

foreign import getTabString :: EditSession -> Effect String

foreign import setUseSoftTabsImpl :: Fn2 Boolean EditSession (Effect Unit)

setUseSoftTabs :: Boolean -> EditSession -> Effect Unit
setUseSoftTabs useSoftTabs self = runFn2 setUseSoftTabsImpl useSoftTabs self

foreign import getUseSoftTabs :: EditSession -> Effect Boolean

foreign import setTabSizeImpl :: Fn2 Int EditSession (Effect Unit)

setTabSize :: Int -> EditSession -> Effect Unit
setTabSize tabSize self = runFn2 setTabSizeImpl tabSize self

foreign import getTabSize :: EditSession -> Effect String

foreign import isTabStopImpl :: Fn2 Position EditSession (Effect Boolean)

isTabStop :: Position -> EditSession -> Effect Boolean
isTabStop position self = runFn2 isTabStopImpl position self

foreign import setOverwriteImpl :: Fn2 Boolean EditSession (Effect Unit)

setOverwrite :: Boolean -> EditSession -> Effect Unit
setOverwrite overwrite self = runFn2 setOverwriteImpl overwrite self

foreign import getOverwrite :: EditSession -> Effect Boolean

foreign import toggleOverwrite :: EditSession -> Effect Unit

foreign import addGutterDecorationImpl :: Fn3 Int String EditSession (Effect Unit)

addGutterDecoration :: Int -> String -> EditSession -> Effect Unit
addGutterDecoration row className self = runFn3 addGutterDecorationImpl row className self

foreign import removeGutterDecorationImpl :: Fn3 Int String EditSession (Effect Unit)

removeGutterDecoration :: Int -> String -> EditSession -> Effect Unit
removeGutterDecoration row className self = runFn3 removeGutterDecorationImpl row className self

foreign import getBreakpoints :: EditSession -> Effect (Array Int)

foreign import setBreakpointsImpl :: Fn2 (Array Int) EditSession (Effect Unit)

setBreakpoints :: Array Int -> EditSession -> Effect Unit
setBreakpoints rows self = runFn2 setBreakpointsImpl rows self

foreign import clearBreakpoints :: EditSession -> Effect Unit

foreign import setBreakpointImpl :: Fn3 Int String EditSession (Effect Unit)

setBreakpoint :: Int -> String -> EditSession -> Effect Unit
setBreakpoint row className self = runFn3 setBreakpointImpl row className self

foreign import clearBreakpointImpl :: Fn2 Int EditSession (Effect Unit)

clearBreakpoint :: Int -> EditSession -> Effect Unit
clearBreakpoint row self = runFn2 clearBreakpointImpl row self

foreign import addMarkerImpl :: Fn5 Range String String Boolean EditSession (Effect Int)

addMarker :: Range -> String -> String -> Boolean -> EditSession -> Effect Int
addMarker range clazz _type inFront self = runFn5 addMarkerImpl range clazz _type inFront self

type DynamicMarker a = forall h. STArray h String -> HTMLElement -> ST h a

foreign import addDynamicMarkerImpl :: forall a. Fn3 (DynamicMarker a) Boolean EditSession (Effect Unit)

addDynamicMarker :: forall a. DynamicMarker a -> Boolean -> EditSession -> Effect Unit
addDynamicMarker marker inFront self = runFn3 addDynamicMarkerImpl marker inFront self

foreign import removeMarkerImpl :: Fn2 Int EditSession (Effect Unit)

removeMarker :: Int -> EditSession -> Effect Unit
removeMarker markerId self = runFn2 removeMarkerImpl markerId self

foreign import setAnnotationsImpl :: Fn2 (Array Annotation) EditSession (Effect Unit)

setAnnotations :: Array Annotation -> EditSession -> Effect Unit
setAnnotations annotations self = runFn2 setAnnotationsImpl annotations self

foreign import getAnnotations :: EditSession -> Effect (Array Annotation)

foreign import clearAnnotations :: EditSession -> Effect Unit

foreign import detectNewLineImpl :: Fn2 String EditSession (Effect Unit)

detectNewLine :: String -> EditSession -> Effect Unit
detectNewLine text self = runFn2 detectNewLineImpl text self

foreign import getWordRangeImpl :: Fn3 Int Int EditSession (Effect Range)

getWordRange :: Int -> Int -> EditSession -> Effect Range
getWordRange row column self = runFn3 getWordRangeImpl row column self

foreign import getAWordRangeImpl :: Fn3 Int Int EditSession (Effect Range)

getAWordRange :: Int -> Int -> EditSession -> Effect Range
getAWordRange row column self = runFn3 getAWordRangeImpl row column self

foreign import setNewLineModeImpl :: Fn2 String EditSession (Effect Unit)

setNewLineMode :: String -> EditSession -> Effect Unit
setNewLineMode newLineMode self = runFn2 setNewLineModeImpl newLineMode self

foreign import getNewLineMode :: EditSession -> Effect String

foreign import setUseWorkerImpl :: Fn2 Boolean EditSession (Effect Unit)

setUseWorker :: Boolean -> EditSession -> Effect Unit
setUseWorker useWorker self = runFn2 setUseWorkerImpl useWorker self

foreign import getUseWorker :: EditSession -> Effect Boolean

foreign import onReloadTokenizer :: EditSession -> Effect Unit

foreign import modeImpl :: Fn2 TextMode EditSession (Effect Unit)

mode :: TextMode -> EditSession -> Effect Unit
mode mode' self = runFn2 modeImpl mode' self

foreign import getMode :: EditSession -> Effect TextMode

foreign import setScrollTopImpl :: Fn2 Int EditSession (Effect Unit)

setScrollTop :: Int -> EditSession -> Effect Unit
setScrollTop scrollTop self = runFn2 setScrollTopImpl scrollTop self

foreign import getScrollTop :: EditSession -> Effect Int

foreign import setScrollLeftImpl :: Fn2 Int EditSession (Effect Unit)

setScrollLeft :: Int -> EditSession -> Effect Unit
setScrollLeft scrollLeft self = runFn2 setScrollLeftImpl scrollLeft self

foreign import getScrollLeft :: EditSession -> Effect Int

foreign import getScreenWidth :: EditSession -> Effect Int

foreign import getLineImpl :: Fn2 Int EditSession (Effect String)

getLine :: Int -> EditSession -> Effect String
getLine row self = runFn2 getLineImpl row self

foreign import getLinesImpl :: Fn3 Int Int EditSession (Effect (Array String))

getLines :: Int -> Int -> EditSession -> Effect (Array String)
getLines firstRow lastRow self = runFn3 getLinesImpl firstRow lastRow self

foreign import getLength :: EditSession -> Effect Int

foreign import getTextRangeImpl :: Fn2 Range EditSession (Effect String)

getTextRange :: Range -> EditSession -> Effect String
getTextRange range self = runFn2 getTextRangeImpl range self

foreign import insertImpl :: Fn3 Position String EditSession (Effect Unit)

insert :: Position -> String -> EditSession -> Effect Unit
insert position text self = runFn3 insertImpl position text self

foreign import removeImpl :: Fn2 Range EditSession (Effect Unit)

remove :: Range -> EditSession -> Effect Unit
remove range self = runFn2 removeImpl range self

foreign import setUndoSelectImpl :: Fn2 Boolean EditSession (Effect Unit)

setUndoSelect :: Boolean -> EditSession -> Effect Unit
setUndoSelect enable self = runFn2 setUndoSelectImpl enable self

foreign import replaceImpl :: Fn3 Range String EditSession (Effect Unit)

replace :: Range -> String -> EditSession -> Effect Unit
replace range text self = runFn3 replaceImpl range text self

foreign import moveTextImpl :: Fn3 Range Position EditSession (Effect Range)

moveText :: Range -> Position -> EditSession -> Effect Range
moveText fromRange toPosition self = runFn3 moveTextImpl fromRange toPosition self

foreign import indentRowsImpl :: Fn4 Int Int String EditSession (Effect Unit)

indentRows :: Int -> Int -> String -> EditSession -> Effect Unit
indentRows startRow endRow indentString self = runFn4 indentRowsImpl startRow endRow indentString self

foreign import outdentRowsImpl :: Fn2 Range EditSession (Effect Unit)

outdentRows :: Range -> EditSession -> Effect Unit
outdentRows range self = runFn2 outdentRowsImpl range self

foreign import moveLinesUpImpl :: Fn3 Int Int EditSession (Effect Int)

moveLinesUp :: Int -> Int -> EditSession -> Effect Int
moveLinesUp firstRow lastRow self = runFn3 moveLinesUpImpl firstRow lastRow self

foreign import moveLinesDownImpl :: Fn3 Int Int EditSession (Effect Int)

moveLinesDown :: Int -> Int -> EditSession -> Effect Int
moveLinesDown firstRow lastRow self = runFn3 moveLinesDownImpl firstRow lastRow self

foreign import duplicateLinesImpl :: Fn3 Int Int EditSession (Effect Int)

duplicateLines :: Int -> Int -> EditSession -> Effect Int
duplicateLines firstRow lastRow self = runFn3 duplicateLinesImpl firstRow lastRow self

foreign import setUseWrapModeImpl :: Fn2 Boolean EditSession (Effect Unit)

setUseWrapMode :: Boolean -> EditSession -> Effect Unit
setUseWrapMode useWrapMode self = runFn2 setUseWrapModeImpl useWrapMode self

foreign import getUseWrapMode :: EditSession -> Effect Boolean

foreign import setWrapLimitRangeImpl :: Fn3 Int Int EditSession (Effect Unit)

setWrapLimitRange :: Int -> Int -> EditSession -> Effect Unit
setWrapLimitRange min max self = runFn3 setWrapLimitRangeImpl min max self

foreign import adjustWrapLimitImpl :: Fn2 Int EditSession (Effect Boolean)

adjustWrapLimit :: Int -> EditSession -> Effect Boolean
adjustWrapLimit desiredLimit self = runFn2 adjustWrapLimitImpl desiredLimit self

foreign import getWrapLimit :: EditSession -> Effect Int

foreign import getWrapLimitRange :: EditSession -> Effect { min :: Int, max :: Int }

foreign import getDisplayTokensImpl :: Fn3 String Int EditSession (Effect Unit)

getDisplayTokens :: String -> Int -> EditSession -> Effect Unit
getDisplayTokens str offset self = runFn3 getDisplayTokensImpl str offset self

foreign import getStringScreenWidthImpl :: Fn4 String Int Int EditSession (Effect (Array Int))

getStringScreenWidth :: String -> Int -> Int -> EditSession -> Effect (Array Int)
getStringScreenWidth str maxScreenColumn screenColumn self = runFn4 getStringScreenWidthImpl str maxScreenColumn screenColumn self

foreign import getRowLengthImpl :: Fn2 Int EditSession (Effect Int)

getRowLength :: Int -> EditSession -> Effect Int
getRowLength row self = runFn2 getRowLengthImpl row self

foreign import getScreenLastRowColumnImpl :: Fn2 Int EditSession (Effect Int)

getScreenLastRowColumn :: Int -> EditSession -> Effect Int
getScreenLastRowColumn screenRow self = runFn2 getScreenLastRowColumnImpl screenRow self

foreign import getDocumentLastRowColumnImpl :: Fn3 Int Int EditSession (Effect Int)

getDocumentLastRowColumn :: Int -> Int -> EditSession -> Effect Int
getDocumentLastRowColumn docRow docColumn self = runFn3 getDocumentLastRowColumnImpl docRow docColumn self

foreign import getDocumentLastRowColumnPositionImpl :: Fn3 Int Int EditSession (Effect Int)

getDocumentLastRowColumnPosition :: Int -> Int -> EditSession -> Effect Int
getDocumentLastRowColumnPosition docRow docColumn self = runFn3 getDocumentLastRowColumnPositionImpl docRow docColumn self

foreign import getRowSplitData :: EditSession -> Effect String

foreign import getScreenTabSizeImpl :: Fn2 Int EditSession (Effect Int)

getScreenTabSize :: Int -> EditSession -> Effect Int
getScreenTabSize screenColumn self = runFn2 getScreenTabSizeImpl screenColumn self

foreign import screenToDocumentPositionImpl :: Fn3 Int Int EditSession (Effect Position)

screenToDocumentPosition :: Int -> Int -> EditSession -> Effect Position
screenToDocumentPosition screenRow screenColumn self = runFn3 screenToDocumentPositionImpl screenRow screenColumn self

foreign import documentToScreenPositionImpl :: Fn3 Int Int EditSession (Effect Position)

documentToScreenPosition :: Int -> Int -> EditSession -> Effect Position
documentToScreenPosition docRow docColumn self = runFn3 documentToScreenPositionImpl docRow docColumn self

foreign import documentToScreenColumnImpl :: Fn3 Int Int EditSession (Effect Int)

documentToScreenColumn :: Int -> Int -> EditSession -> Effect Int
documentToScreenColumn row docColumn self = runFn3 documentToScreenColumnImpl row docColumn self

foreign import documentToScreenRowImpl :: Fn3 Int Int EditSession (Effect Unit)

documentToScreenRow :: Int -> Int -> EditSession -> Effect Unit
documentToScreenRow docRow docColumn self = runFn3 documentToScreenRowImpl docRow docColumn self

foreign import getScreenLength :: EditSession -> Effect Int

foreign import createWithModeImpl :: Fn2 String (Nullable TextMode) (Effect EditSession)

createWithMode :: String -> Maybe TextMode -> Effect EditSession
createWithMode text mode' = runFn2 createWithModeImpl text (toNullable mode')

foreign import createImpl :: Fn2 String (Nullable String) (Effect EditSession)

create :: String -> Maybe String -> Effect EditSession
create content mode' = runFn2 createImpl content (toNullable mode')

foreign import createFromLinesImpl :: Fn2 (Array String) (Nullable String) (Effect EditSession)

createFromLines :: Array String -> Maybe String -> Effect EditSession
createFromLines text mode' = runFn2 createFromLinesImpl text (toNullable mode')

foreign import getMarkers
  :: EditSession -> Effect (Array Marker)

module Ace.EditSession
  ( DynamicMarker
  , addDynamicMarker
  , addFold
  , addGutterDecoration
  , addMarker
  , adjustWrapLimit
  , clearAnnotations
  , clearBreakpoint
  , clearBreakpoints
  , createWithMode
  , createFromLines
  , create
  , detectNewLine
  , documentToScreenColumn
  , documentToScreenPosition
  , documentToScreenRow
  , duplicateLines
  , findMatchingBracket
  , getAWordRange
  , getAnnotations
  , getBackgroundTokenizer
  , getBreakpoints
  , getDisplayTokens
  , getDocument
  , getDocumentLastRowColumn
  , getDocumentLastRowColumnPosition
  , getLength
  , getLine
  , getLines
  , getMode
  , getNewLineMode
  , getOverwrite
  , getRowLength
  , getRowSplitData
  , getScreenLastRowColumn
  , getScreenLength
  , getScreenTabSize
  , getScreenWidth
  , getScrollLeft
  , getScrollTop
  , getSelection
  , getState
  , getStringScreenWidth
  , getTabSize
  , getTabString
  , getTextRange
  , getTokenAt
  , getTokens
  , getUndoManager
  , getUseSoftTabs
  , getUseWorker
  , getUseWrapMode
  , getValue
  , getWordRange
  , getWrapLimit
  , getWrapLimitRange
  , highlight
  , indentRows
  , insert
  , isTabStop
  , mode
  , moveLinesDown
  , moveLinesUp
  , moveText
  , onChange
  , onChangeAnnotation
  , onChangeBackMarker
  , onChangeBreakpoint
  , onChangeFold
  , onChangeFrontMarker
  , onChangeMode
  , onChangeOverwrite
  , onChangeScrollLeft
  , onChangeScrollTop
  , onChangeTabSize
  , onChangeWrapLimit
  , onChangeWrapMode
  , onTokenizerUpdate
  , onReloadTokenizer
  , outdentRows
  , remove
  , removeGutterDecoration
  , removeMarker
  , replace
  , resetRowCache
  , screenToDocumentColumn
  , screenToDocumentPosition
  , setAnnotations
  , setBreakpoint
  , setBreakpoints
  , setDocument
  , setMode
  , setNewLineMode
  , setOverwrite
  , setScrollLeft
  , setScrollTop
  , setTabSize
  , setUndoManager
  , setUndoSelect
  , setUseSoftTabs
  , setUseWorker
  , setUseWrapMode
  , setValue
  , setWrapLimitRange
  , toggleOverwrite
  , getMarkers
  ) where

import Prelude

import Ace.Types (Marker, EditSession, TextMode, Position, Range, Annotation, UndoManager, TokenInfo, Selection, Document, BackgroundTokenizer)
import Control.Monad.ST (ST)
import Data.Array.ST (STArray)
import Data.Function.Uncurried (Fn2, runFn2, Fn3, runFn3, Fn4, runFn4, Fn5, runFn5)
import Data.Maybe (Maybe)
import Data.Nullable (Nullable, toNullable)
import Effect (Effect)
import Web.HTML.HTMLElement (HTMLElement)

foreign import getBackgroundTokenizer :: EditSession -> Effect BackgroundTokenizer

foreign import onImpl :: forall ev a. Fn3 String (ev -> Effect a) EditSession (Effect Unit)

onChange :: forall a. EditSession -> Effect a -> Effect Unit
onChange self fn = runFn3 onImpl "change" (\_ -> fn) self

onChangeAnnotation :: forall a. EditSession -> Effect a -> Effect Unit
onChangeAnnotation self fn = runFn3 onImpl "changeAnnotation" (\_ -> fn) self

onChangeBackMarker :: forall a. EditSession -> Effect a -> Effect Unit
onChangeBackMarker self fn = runFn3 onImpl "changeBackMarker" (\_ -> fn) self

onChangeBreakpoint :: forall a. EditSession -> Effect a -> Effect Unit
onChangeBreakpoint self fn = runFn3 onImpl "changeBreakpoint" (\_ -> fn) self

onChangeFold :: forall a. EditSession -> Effect a -> Effect Unit
onChangeFold self fn = runFn3 onImpl "changeFold" (\_ -> fn) self

onChangeFrontMarker :: forall a. EditSession -> Effect a -> Effect Unit
onChangeFrontMarker self fn = runFn3 onImpl "changeFrontMarker" (\_ -> fn) self

onChangeMode :: forall a. EditSession -> Effect a -> Effect Unit
onChangeMode self fn = runFn3 onImpl "changeMode" (\_ -> fn) self

onChangeOverwrite :: forall a. EditSession -> Effect a -> Effect Unit
onChangeOverwrite self fn = runFn3 onImpl "changeOverwrite" (\_ -> fn) self

onChangeScrollLeft :: forall a. EditSession -> (Int -> Effect a) -> Effect Unit
onChangeScrollLeft self fn = runFn3 onImpl "changeScrollLeft" fn self

onChangeScrollTop :: forall a. EditSession -> (Int -> Effect a) -> Effect Unit
onChangeScrollTop self fn = runFn3 onImpl "changeScrollTop" fn self

onChangeTabSize :: forall a. EditSession -> Effect a -> Effect Unit
onChangeTabSize self fn = runFn3 onImpl "changeTabSize" (\_ -> fn) self

onChangeWrapLimit :: forall a. EditSession -> Effect a -> Effect Unit
onChangeWrapLimit self fn = runFn3 onImpl "changeWrapLimit" (\_ -> fn) self

onChangeWrapMode :: forall a. EditSession -> Effect a -> Effect Unit
onChangeWrapMode self fn = runFn3 onImpl "changeWrapMode" (\_ -> fn) self

onTokenizerUpdate :: forall a. EditSession -> Effect a -> Effect Unit
onTokenizerUpdate self fn = runFn3 onImpl "tokenizerUpdate" (\_ -> fn) self

foreign import findMatchingBracketImpl :: Fn2 Position EditSession (Effect Unit)

findMatchingBracket :: Position -> EditSession -> Effect Unit
findMatchingBracket position self = runFn2 findMatchingBracketImpl position self

foreign import addFoldImpl :: Fn3 String Range EditSession (Effect Unit)

addFold :: String -> Range -> EditSession -> Effect Unit
addFold text range self = runFn3 addFoldImpl text range self

foreign import screenToDocumentColumnImpl :: Fn3 Int Int EditSession (Effect Unit)

screenToDocumentColumn :: Int -> Int -> EditSession -> Effect Unit
screenToDocumentColumn row column self = runFn3 screenToDocumentColumnImpl row column self

foreign import highlightImpl :: Fn2 String EditSession (Effect Unit)

highlight :: String -> EditSession -> Effect Unit
highlight text self = runFn2 highlightImpl text self

foreign import setDocumentImpl :: Fn2 Document EditSession (Effect Unit)

setDocument :: Document -> EditSession -> Effect Unit
setDocument doc self = runFn2 setDocumentImpl doc self

foreign import getDocument :: EditSession -> Effect Document

foreign import resetRowCacheImpl :: Fn2 Int EditSession (Effect Unit)

resetRowCache :: Int -> EditSession -> Effect Unit
resetRowCache row self = runFn2 resetRowCacheImpl row self

foreign import setValueImpl :: Fn2 String EditSession (Effect Unit)

setValue :: String -> EditSession -> Effect Unit
setValue text self = runFn2 setValueImpl text self

foreign import setModeImpl :: Fn2 String EditSession (Effect Unit)

setMode :: String -> EditSession -> Effect Unit
setMode mode' self = runFn2 setModeImpl mode' self

foreign import getValue :: EditSession -> Effect String

foreign import getSelection :: EditSession -> Effect Selection

foreign import getStateImpl :: Fn2 Int EditSession (Effect String)

getState :: Int -> EditSession -> Effect String
getState row self = runFn2 getStateImpl row self

foreign import getTokensImpl :: Fn2 Int EditSession (Effect (Array TokenInfo))

getTokens :: Int -> EditSession -> Effect (Array TokenInfo)
getTokens row self = runFn2 getTokensImpl row self

foreign import getTokenAtImpl :: Fn3 Int Int EditSession (Effect TokenInfo)

getTokenAt :: Int -> Int -> EditSession -> Effect TokenInfo
getTokenAt row column self = runFn3 getTokenAtImpl row column self

foreign import setUndoManagerImpl :: Fn2 UndoManager EditSession (Effect Unit)

setUndoManager :: UndoManager -> EditSession -> Effect Unit
setUndoManager undoManager self = runFn2 setUndoManagerImpl undoManager self

foreign import getUndoManager :: EditSession -> Effect UndoManager

foreign import getTabString :: EditSession -> Effect String

foreign import setUseSoftTabsImpl :: Fn2 Boolean EditSession (Effect Unit)

setUseSoftTabs :: Boolean -> EditSession -> Effect Unit
setUseSoftTabs useSoftTabs self = runFn2 setUseSoftTabsImpl useSoftTabs self

foreign import getUseSoftTabs :: EditSession -> Effect Boolean

foreign import setTabSizeImpl :: Fn2 Int EditSession (Effect Unit)

setTabSize :: Int -> EditSession -> Effect Unit
setTabSize tabSize self = runFn2 setTabSizeImpl tabSize self

foreign import getTabSize :: EditSession -> Effect String

foreign import isTabStopImpl :: Fn2 Position EditSession (Effect Boolean)

isTabStop :: Position -> EditSession -> Effect Boolean
isTabStop position self = runFn2 isTabStopImpl position self

foreign import setOverwriteImpl :: Fn2 Boolean EditSession (Effect Unit)

setOverwrite :: Boolean -> EditSession -> Effect Unit
setOverwrite overwrite self = runFn2 setOverwriteImpl overwrite self

foreign import getOverwrite :: EditSession -> Effect Boolean

foreign import toggleOverwrite :: EditSession -> Effect Unit

foreign import addGutterDecorationImpl :: Fn3 Int String EditSession (Effect Unit)

addGutterDecoration :: Int -> String -> EditSession -> Effect Unit
addGutterDecoration row className self = runFn3 addGutterDecorationImpl row className self

foreign import removeGutterDecorationImpl :: Fn3 Int String EditSession (Effect Unit)

removeGutterDecoration :: Int -> String -> EditSession -> Effect Unit
removeGutterDecoration row className self = runFn3 removeGutterDecorationImpl row className self

foreign import getBreakpoints :: EditSession -> Effect (Array Int)

foreign import setBreakpointsImpl :: Fn2 (Array Int) EditSession (Effect Unit)

setBreakpoints :: Array Int -> EditSession -> Effect Unit
setBreakpoints rows self = runFn2 setBreakpointsImpl rows self

foreign import clearBreakpoints :: EditSession -> Effect Unit

foreign import setBreakpointImpl :: Fn3 Int String EditSession (Effect Unit)

setBreakpoint :: Int -> String -> EditSession -> Effect Unit
setBreakpoint row className self = runFn3 setBreakpointImpl row className self

foreign import clearBreakpointImpl :: Fn2 Int EditSession (Effect Unit)

clearBreakpoint :: Int -> EditSession -> Effect Unit
clearBreakpoint row self = runFn2 clearBreakpointImpl row self

foreign import addMarkerImpl :: Fn5 Range String String Boolean EditSession (Effect Int)

addMarker :: Range -> String -> String -> Boolean -> EditSession -> Effect Int
addMarker range clazz _type inFront self = runFn5 addMarkerImpl range clazz _type inFront self

type DynamicMarker a = forall h. STArray h String -> HTMLElement -> ST h a

foreign import addDynamicMarkerImpl :: forall a. Fn3 (DynamicMarker a) Boolean EditSession (Effect Unit)

addDynamicMarker :: forall a. DynamicMarker a -> Boolean -> EditSession -> Effect Unit
addDynamicMarker marker inFront self = runFn3 addDynamicMarkerImpl marker inFront self

foreign import removeMarkerImpl :: Fn2 Int EditSession (Effect Unit)

removeMarker :: Int -> EditSession -> Effect Unit
removeMarker markerId self = runFn2 removeMarkerImpl markerId self

foreign import setAnnotationsImpl :: Fn2 (Array Annotation) EditSession (Effect Unit)

setAnnotations :: Array Annotation -> EditSession -> Effect Unit
setAnnotations annotations self = runFn2 setAnnotationsImpl annotations self

foreign import getAnnotations :: EditSession -> Effect (Array Annotation)

foreign import clearAnnotations :: EditSession -> Effect Unit

foreign import detectNewLineImpl :: Fn2 String EditSession (Effect Unit)

detectNewLine :: String -> EditSession -> Effect Unit
detectNewLine text self = runFn2 detectNewLineImpl text self

foreign import getWordRangeImpl :: Fn3 Int Int EditSession (Effect Range)

getWordRange :: Int -> Int -> EditSession -> Effect Range
getWordRange row column self = runFn3 getWordRangeImpl row column self

foreign import getAWordRangeImpl :: Fn3 Int Int EditSession (Effect Range)

getAWordRange :: Int -> Int -> EditSession -> Effect Range
getAWordRange row column self = runFn3 getAWordRangeImpl row column self

foreign import setNewLineModeImpl :: Fn2 String EditSession (Effect Unit)

setNewLineMode :: String -> EditSession -> Effect Unit
setNewLineMode newLineMode self = runFn2 setNewLineModeImpl newLineMode self

foreign import getNewLineMode :: EditSession -> Effect String

foreign import setUseWorkerImpl :: Fn2 Boolean EditSession (Effect Unit)

setUseWorker :: Boolean -> EditSession -> Effect Unit
setUseWorker useWorker self = runFn2 setUseWorkerImpl useWorker self

foreign import getUseWorker :: EditSession -> Effect Boolean

foreign import onReloadTokenizer :: EditSession -> Effect Unit

foreign import modeImpl :: Fn2 TextMode EditSession (Effect Unit)

mode :: TextMode -> EditSession -> Effect Unit
mode mode' self = runFn2 modeImpl mode' self

foreign import getMode :: EditSession -> Effect TextMode

foreign import setScrollTopImpl :: Fn2 Int EditSession (Effect Unit)

setScrollTop :: Int -> EditSession -> Effect Unit
setScrollTop scrollTop self = runFn2 setScrollTopImpl scrollTop self

foreign import getScrollTop :: EditSession -> Effect Int

foreign import setScrollLeftImpl :: Fn2 Int EditSession (Effect Unit)

setScrollLeft :: Int -> EditSession -> Effect Unit
setScrollLeft scrollLeft self = runFn2 setScrollLeftImpl scrollLeft self

foreign import getScrollLeft :: EditSession -> Effect Int

foreign import getScreenWidth :: EditSession -> Effect Int

foreign import getLineImpl :: Fn2 Int EditSession (Effect String)

getLine :: Int -> EditSession -> Effect String
getLine row self = runFn2 getLineImpl row self

foreign import getLinesImpl :: Fn3 Int Int EditSession (Effect (Array String))

getLines :: Int -> Int -> EditSession -> Effect (Array String)
getLines firstRow lastRow self = runFn3 getLinesImpl firstRow lastRow self

foreign import getLength :: EditSession -> Effect Int

foreign import getTextRangeImpl :: Fn2 Range EditSession (Effect String)

getTextRange :: Range -> EditSession -> Effect String
getTextRange range self = runFn2 getTextRangeImpl range self

foreign import insertImpl :: Fn3 Position String EditSession (Effect Unit)

insert :: Position -> String -> EditSession -> Effect Unit
insert position text self = runFn3 insertImpl position text self

foreign import removeImpl :: Fn2 Range EditSession (Effect Unit)

remove :: Range -> EditSession -> Effect Unit
remove range self = runFn2 removeImpl range self

foreign import setUndoSelectImpl :: Fn2 Boolean EditSession (Effect Unit)

setUndoSelect :: Boolean -> EditSession -> Effect Unit
setUndoSelect enable self = runFn2 setUndoSelectImpl enable self

foreign import replaceImpl :: Fn3 Range String EditSession (Effect Unit)

replace :: Range -> String -> EditSession -> Effect Unit
replace range text self = runFn3 replaceImpl range text self

foreign import moveTextImpl :: Fn3 Range Position EditSession (Effect Range)

moveText :: Range -> Position -> EditSession -> Effect Range
moveText fromRange toPosition self = runFn3 moveTextImpl fromRange toPosition self

foreign import indentRowsImpl :: Fn4 Int Int String EditSession (Effect Unit)

indentRows :: Int -> Int -> String -> EditSession -> Effect Unit
indentRows startRow endRow indentString self = runFn4 indentRowsImpl startRow endRow indentString self

foreign import outdentRowsImpl :: Fn2 Range EditSession (Effect Unit)

outdentRows :: Range -> EditSession -> Effect Unit
outdentRows range self = runFn2 outdentRowsImpl range self

foreign import moveLinesUpImpl :: Fn3 Int Int EditSession (Effect Int)

moveLinesUp :: Int -> Int -> EditSession -> Effect Int
moveLinesUp firstRow lastRow self = runFn3 moveLinesUpImpl firstRow lastRow self

foreign import moveLinesDownImpl :: Fn3 Int Int EditSession (Effect Int)

moveLinesDown :: Int -> Int -> EditSession -> Effect Int
moveLinesDown firstRow lastRow self = runFn3 moveLinesDownImpl firstRow lastRow self

foreign import duplicateLinesImpl :: Fn3 Int Int EditSession (Effect Int)

duplicateLines :: Int -> Int -> EditSession -> Effect Int
duplicateLines firstRow lastRow self = runFn3 duplicateLinesImpl firstRow lastRow self

foreign import setUseWrapModeImpl :: Fn2 Boolean EditSession (Effect Unit)

setUseWrapMode :: Boolean -> EditSession -> Effect Unit
setUseWrapMode useWrapMode self = runFn2 setUseWrapModeImpl useWrapMode self

foreign import getUseWrapMode :: EditSession -> Effect Boolean

foreign import setWrapLimitRangeImpl :: Fn3 Int Int EditSession (Effect Unit)

setWrapLimitRange :: Int -> Int -> EditSession -> Effect Unit
setWrapLimitRange min max self = runFn3 setWrapLimitRangeImpl min max self

foreign import adjustWrapLimitImpl :: Fn2 Int EditSession (Effect Boolean)

adjustWrapLimit :: Int -> EditSession -> Effect Boolean
adjustWrapLimit desiredLimit self = runFn2 adjustWrapLimitImpl desiredLimit self

foreign import getWrapLimit :: EditSession -> Effect Int

foreign import getWrapLimitRange :: EditSession -> Effect { min :: Int, max :: Int }

foreign import getDisplayTokensImpl :: Fn3 String Int EditSession (Effect Unit)

getDisplayTokens :: String -> Int -> EditSession -> Effect Unit
getDisplayTokens str offset self = runFn3 getDisplayTokensImpl str offset self

foreign import getStringScreenWidthImpl :: Fn4 String Int Int EditSession (Effect (Array Int))

getStringScreenWidth :: String -> Int -> Int -> EditSession -> Effect (Array Int)
getStringScreenWidth str maxScreenColumn screenColumn self = runFn4 getStringScreenWidthImpl str maxScreenColumn screenColumn self

foreign import getRowLengthImpl :: Fn2 Int EditSession (Effect Int)

getRowLength :: Int -> EditSession -> Effect Int
getRowLength row self = runFn2 getRowLengthImpl row self

foreign import getScreenLastRowColumnImpl :: Fn2 Int EditSession (Effect Int)

getScreenLastRowColumn :: Int -> EditSession -> Effect Int
getScreenLastRowColumn screenRow self = runFn2 getScreenLastRowColumnImpl screenRow self

foreign import getDocumentLastRowColumnImpl :: Fn3 Int Int EditSession (Effect Int)

getDocumentLastRowColumn :: Int -> Int -> EditSession -> Effect Int
getDocumentLastRowColumn docRow docColumn self = runFn3 getDocumentLastRowColumnImpl docRow docColumn self

foreign import getDocumentLastRowColumnPositionImpl :: Fn3 Int Int EditSession (Effect Int)

getDocumentLastRowColumnPosition :: Int -> Int -> EditSession -> Effect Int
getDocumentLastRowColumnPosition docRow docColumn self = runFn3 getDocumentLastRowColumnPositionImpl docRow docColumn self

foreign import getRowSplitData :: EditSession -> Effect String

foreign import getScreenTabSizeImpl :: Fn2 Int EditSession (Effect Int)

getScreenTabSize :: Int -> EditSession -> Effect Int
getScreenTabSize screenColumn self = runFn2 getScreenTabSizeImpl screenColumn self

foreign import screenToDocumentPositionImpl :: Fn3 Int Int EditSession (Effect Position)

screenToDocumentPosition :: Int -> Int -> EditSession -> Effect Position
screenToDocumentPosition screenRow screenColumn self = runFn3 screenToDocumentPositionImpl screenRow screenColumn self

foreign import documentToScreenPositionImpl :: Fn3 Int Int EditSession (Effect Position)

documentToScreenPosition :: Int -> Int -> EditSession -> Effect Position
documentToScreenPosition docRow docColumn self = runFn3 documentToScreenPositionImpl docRow docColumn self

foreign import documentToScreenColumnImpl :: Fn3 Int Int EditSession (Effect Int)

documentToScreenColumn :: Int -> Int -> EditSession -> Effect Int
documentToScreenColumn row docColumn self = runFn3 documentToScreenColumnImpl row docColumn self

foreign import documentToScreenRowImpl :: Fn3 Int Int EditSession (Effect Unit)

documentToScreenRow :: Int -> Int -> EditSession -> Effect Unit
documentToScreenRow docRow docColumn self = runFn3 documentToScreenRowImpl docRow docColumn self

foreign import getScreenLength :: EditSession -> Effect Int

foreign import createWithModeImpl :: Fn2 String (Nullable TextMode) (Effect EditSession)

createWithMode :: String -> Maybe TextMode -> Effect EditSession
createWithMode text mode' = runFn2 createWithModeImpl text (toNullable mode')

foreign import createImpl :: Fn2 String (Nullable String) (Effect EditSession)

create :: String -> Maybe String -> Effect EditSession
create content mode' = runFn2 createImpl content (toNullable mode')

foreign import createFromLinesImpl :: Fn2 (Array String) (Nullable String) (Effect EditSession)

createFromLines :: Array String -> Maybe String -> Effect EditSession
createFromLines text mode' = runFn2 createFromLinesImpl text (toNullable mode')

foreign import getMarkers
  :: EditSession -> Effect (Array Marker)


Add UI debugging function & traces

Add UI debugging function & traces

module Genetics.Browser.Track.UI where

import Prelude

import Color (black)
import Color.Scheme.Clrs (blue, red)
import Control.Coroutine (Consumer, Producer, connect, runProcess)
import Control.Coroutine as Co
import Control.Monad.Aff (Aff, Fiber, Milliseconds(..), delay, finally, forkAff, killFiber, launchAff, launchAff_)
import Control.Monad.Aff.AVar (AVar, makeEmptyVar, makeVar, putVar, readVar, takeVar, tryTakeVar)
import Control.Monad.Aff.AVar as AVar
import Control.Monad.Eff (Eff, forE, foreachE)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (log)
import Control.Monad.Eff.Exception (error)
import Control.Monad.Eff.Random (random, randomRange)
import Control.Monad.Eff.Uncurried (EffFn4, runEffFn4)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Rec.Class (forever)
import DOM.Classy.Node (toNode)
import DOM.Classy.ParentNode (toParentNode)
import DOM.HTML (window) as DOM
import DOM.HTML.Types (htmlDocumentToDocument) as DOM
import DOM.HTML.Window (document) as DOM
import DOM.Node.Element as DOM
import DOM.Node.Node (appendChild) as DOM
import DOM.Node.ParentNode (querySelector) as DOM
import DOM.Node.Types (Element, Node)
import Data.Argonaut (Json, _Number, _Object, _String)
import Data.Array as Array
import Data.Bifunctor (bimap)
import Data.BigInt (BigInt)
import Data.BigInt as BigInt
import Data.Either (Either(..), note)
import Data.Filterable (filter)
import Data.Foldable (class Foldable, foldMap, for_, null)
import Data.Foreign (Foreign, MultipleErrors, renderForeignError)
import Data.Lens (to, (^.), (^?))
import Data.Lens.Index (ix)
import Data.List (List)
import Data.List as List
import Data.Map (Map)
import Data.Maybe (Maybe(Just, Nothing), fromJust, fromMaybe)
import Data.Monoid (class Monoid, mempty)
import Data.Newtype (ala, over, unwrap, wrap)
import Data.Nullable (Nullable, toMaybe)
import Data.Pair (Pair(..))
import Data.Symbol (SProxy(..))
import Data.Traversable (for, traverse, traverse_)
import Data.Tuple (Tuple(Tuple))
import Genetics.Browser.Track.Backend (Padding, RenderedTrack, browser, bumpFeatures, zipMapsWith)
import Genetics.Browser.Track.Demo (Annot, BedFeature, GWASFeature, annotLegendTest, demoTracks, getAnnotations, getGWAS, getGenes, gwasDraw, gwasGlyphTest, produceAnnots, produceGWAS, produceGenes)
import Genetics.Browser.Track.UI.Canvas (BrowserCanvas, TrackPadding, blankTrack, browserCanvas, debugBrowserCanvas, drawOnTrack, flipTrack, renderBatchGlyphs, renderBrowser, renderSingleGlyphs, renderTrack, trackViewScale, transTrack)
import Genetics.Browser.Types (Bp(..), ChrId(ChrId), Point)
import Genetics.Browser.Types.Coordinates (CoordSys(..), CoordSysView(..), ViewScale(..), _TotalSize, coordSys, normalizeView, pairSize, pixelsView, scalePairBy, scaleViewBy, showViewScale, translatePairBy, translateViewBy)
import Global.Unsafe (unsafeStringify)
import Graphics.Canvas (CanvasElement, Context2D, fillRect, getContext2D, setFillStyle)
import Graphics.Canvas as Canvas
import Graphics.Drawing (Drawing, fillColor, filled, rectangle, white)
import Graphics.Drawing as Drawing
import Partial.Unsafe (unsafeCrashWith, unsafePartial)
import Simple.JSON (read, readJSON)
import Unsafe.Coerce (unsafeCoerce)

foreign import windowInnerSize :: forall e.
                                  Eff e Canvas.Dimensions

-- | Set an event to fire on the given button id
foreign import buttonEvent :: forall eff.
                              String
                           -> Eff eff Unit
                           -> Eff eff Unit

type ViewRange = Pair BigInt

data UpdateView =
    ScrollView Number
  | ZoomView Number
  | ModView (Pair BigInt -> Pair BigInt)

instance showUpdateView :: Show UpdateView where
  show (ScrollView x) = "(Scroll by " <> show x <> ")"
  show (ZoomView s) = "(Zoom by " <> show s <> ")"
  show _ = "(ModView)"

    -- TODO idk if this instance makes sense??? whatevs
instance semigroupUpdateView :: Semigroup UpdateView where
  append (ScrollView x1) (ScrollView x2) = ScrollView (x1 + x2)
  append (ZoomView s1)   (ZoomView s2)   = ZoomView   (s1 * s2)
  append _ y = y

instance monoidUpdateView :: Monoid UpdateView where
  mempty = ModView id

updateViewFold :: UpdateView
               -> CoordSysView
               -> CoordSysView
updateViewFold uv iv = case uv of
  ZoomView   x -> iv `scaleViewBy`     x
  ScrollView x -> iv `translateViewBy` x
  ModView f    -> over CoordSysView f iv

queueCmd :: AVar UpdateView -> UpdateView -> Eff _ Unit
queueCmd av cmd = launchAff_ $ putVar cmd av

btnScroll :: Number -> AVar UpdateView -> Eff _ Unit
btnScroll x av = do
  buttonEvent "scrollLeft"  $ queueCmd av $ ScrollView (-x)
  buttonEvent "scrollRight" $ queueCmd av $ ScrollView   x

btnZoom :: Number -> AVar UpdateView -> Eff _ Unit
btnZoom x av = do
  buttonEvent "zoomOut" $ queueCmd av $ ZoomView $ 1.0 + x
  buttonEvent "zoomIn"  $ queueCmd av $ ZoomView $ 1.0 - x

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

-- runs console.time() with the provided string, returns the effect to stop the timer
foreign import timeEff :: forall eff. String -> Eff eff (Eff eff Unit)

type UIState e = { view :: AVar CoordSysView
                 , viewCmd :: AVar UpdateView
                 , viewReady :: AVar Unit
                 , renderFiber :: AVar (Fiber e Unit)
                 , cachedTracks :: AVar { cachedScale :: ViewScale
                                        , glyphs :: List (Array RenderedTrack) }
                 }

diffView :: CoordSysView -> CoordSysView -> CoordSysView
diffView v1 v2 =
  let (Pair l1 r1) = unwrap v1
      (Pair l2 r2) = unwrap v2
  in wrap $ Pair (l2 - l1) (r2 - r1)

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

peekUIState :: UIState _
            -> Eff _ Unit
peekUIState s = launchAff_ do
  view <- AVar.tryReadVar s.view
  case view of
    Nothing -> liftEff $ log "CoordSysView state empty"
    Just v  ->
      liftEff $ log $ "CoordSysView: " <> showView v

uiViewUpdate :: forall r.
                CoordSys _ BigInt
             -> Milliseconds
             -> { view :: AVar CoordSysView
                , viewCmd :: AVar UpdateView
                , viewReady :: AVar Unit| r }
             -> Aff _ Unit
uiViewUpdate cs timeout { view, viewCmd, viewReady } = do
  curCmdVar <- makeVar mempty

  let normView = normalizeView cs (BigInt.fromInt 2000)

      loop' updater = do
        cmd <- takeVar viewCmd

        killFiber (error "Resetting view update") updater
        liftEff $ log $ "forking view update"

        curCmd <- takeVar curCmdVar
        let cmd' = curCmd <> cmd
        putVar cmd' curCmdVar

        updater' <- forkAff do
            delay timeout
            liftEff $ log "Running view update"
            vr <- takeVar view

            liftEff $ log $ "   <  " <> showView vr
            let vr' = updateViewFold cmd' vr

            putVar vr' view
            liftEff $ log $ "   |  " <> show cmd'
            liftEff $ log $ "   >  " <> showView vr'
            liftEff $ log $ "diff: " <> showView (diffView vr vr')
            -- putVar (normView $ updateViewFold cmd' vr) view
            putVar unit viewReady
            takeVar curCmdVar *> putVar mempty curCmdVar

        loop' updater'

  loop' (pure unit)

renderLoop :: CoordSys _ _
           -> { tracks     :: Pair BigInt -> List (Array RenderedTrack)
              , relativeUI :: Pair BigInt -> Drawing
              , fixedUI :: Drawing }
           -> BrowserCanvas
           -> UIState _
           -> Aff _ Unit
renderLoop cSys browser canvas state = forever do

  _ <- takeVar state.viewReady

  csView <- readVar state.view
  -- if there's a rendering fiber running, we kill it
  traverse_ (killFiber (error "Resetting renderer"))
    =<< tryTakeVar state.renderFiber

  let uiScale = trackViewScale canvas csView

  -- if the view scale is unchanged, use the cached glyphs
  tracks' <- do
    cache <- AVar.tryTakeVar state.cachedTracks
    case cache of
      Just ct
        | ct.cachedScale == uiScale -> do
            AVar.putVar ct state.cachedTracks
            pure ct.glyphs
      _ -> do
        let cachedScale = uiScale
            glyphs = browser.tracks (unwrap csView)

        AVar.putVar {cachedScale, glyphs} state.cachedTracks
        pure glyphs

  -- fork a new renderFiber

  let (Pair offset _) = pixelsView uiScale csView

      relativeUI = browser.relativeUI (unwrap csView)
      fixedUI = browser.fixedUI

      ui ::  { tracks     :: List (Array RenderedTrack)
             , relativeUI :: Drawing
             , fixedUI :: Drawing }
      ui = { tracks: tracks'
           , relativeUI, fixedUI }

  renderFiber <- forkAff
                 $ renderBrowser (wrap 3.0) canvas offset ui

  putVar renderFiber state.renderFiber

-- TODO configure UI widths
runBrowser :: Conf -> BrowserCanvas -> Eff _ _
runBrowser config bc = launchAff $ do

  {width} <- liftEff $ windowInnerSize

  let height = config.browserHeight
      browserDimensions = {width, height}
      vScaleWidth = 60.0
      legendWidth = 120.0
      trackWidth = width - (vScaleWidth + legendWidth)

  let cSys :: CoordSys ChrId BigInt
      cSys = coordSys mouseChrSizes

  trackData <- do
    genes <- traverse (getGenes cSys) config.urls.genes
    gwas  <- traverse (getGWAS  cSys) config.urls.gwas
    rawAnnotations <-
      traverse (getAnnotations cSys) config.urls.annotations

    let annotations = zipMapsWith
                       (bumpFeatures (to _.score) (SProxy :: SProxy "score")
                         (Bp 1000000.0))
                       <$> gwas <*> rawAnnotations

    pure { genes, gwas, annotations }

  let initialView :: CoordSysView
      initialView = wrap $ Pair zero (cSys^._TotalSize)

  viewCmd <- makeEmptyVar
  liftEff $ do
    btnScroll 0.05 viewCmd
    btnZoom   0.10 viewCmd
    -- dragScroll trackWidth bCanvas viewCmd
    -- wheelZoom 0.02 viewCmd bCanvas.overlay

  view <- makeVar initialView
  viewReady <- makeVar unit
  renderFiber <- makeEmptyVar
  cachedTracks <- AVar.makeEmptyVar

  let initState :: UIState _
      initState = { view, viewCmd, viewReady, renderFiber, cachedTracks }

  let
      entries = foldMap annotLegendTest trackData.annotations
      legend = { width: legendWidth, entries }

      s = config.score

      vscale = { width: vScaleWidth, color: black
               , min: s.min, max: s.max, sig: s.sig }

      tracks = demoTracks vscale trackData

      padding = { horizontal: config.trackPadding.left
                , vertical: config.trackPadding.top }

      mainBrowser = browser cSys trackDimensions browserDimensions {legend, vscale} tracks

      viewTimeout :: Milliseconds
      viewTimeout = wrap 100.0

  liftEff do
    setWindow "mainBrowser" mainBrowser
    setWindow "peekView" (peekUIState initState)

  _ <- forkAff $ uiViewUpdate cSys viewTimeout initState
  _ <- forkAff $ renderLoop cSys mainBrowser bc initState

  pure unit

type DataURLs = { gwas        :: Maybe String
                , annotations :: Maybe String
                , genes       :: Maybe String
                }

type Conf = { browserHeight :: Number
            , trackPadding :: TrackPadding
            , score :: { min :: Number, max :: Number, sig :: Number }
            , urls :: DataURLs
            }

foreign import setWindow :: forall e a. String -> a -> Eff e Unit

initBrowser :: Foreign -> Eff _ _
initBrowser rawConfig = do

  el' <- do
    doc <- DOM.htmlDocumentToDocument
           <$> (DOM.document =<< DOM.window)
    DOM.querySelector (wrap "#browser") (toParentNode doc)

  case read rawConfig :: Either MultipleErrors Conf of
    Left errs -> traverse_ (log <<< renderForeignError) errs
    Right c   -> do
      case el' of
        Nothing -> log "Could not find element '#browser'"
        Just el -> do

          {width} <- windowInnerSize
          let dimensions = { width, height: c.browserHeight }
          bc <- browserCanvas dimensions c.trackPadding el

          debugBrowserCanvas "debugBC" bc

          let drawR :: Number -> Number -> Eff _ Unit
              drawR x y = drawOnTrack bc \ctx -> do
                _ <- setFillStyle "red" ctx
                _ <- fillRect ctx { x, y, w: 20.0, h: 20.0 }
                pure unit

          setWindow "drawRect" drawR
          setWindow "flipTrack" (flipTrack bc)
          setWindow "blankTrack" (blankTrack bc)

          log $ unsafeStringify c
          void $ runBrowser c bc

-- TODO this could almost certainly be done better
chunkConsumer :: forall m a.
                 Foldable m
              => Monoid (m a)
              => AVar (m a)
              -> Consumer (m a) (Aff _) Unit
chunkConsumer av = Co.consumer \m ->
  if null m
     then pure $ Just unit
     else do
       sofar <- takeVar av
       putVar (sofar <> m) av
       delay (wrap 20.0)
       pure Nothing

type TrackVar a = AVar (Map ChrId (Array a))
type TrackProducer eff a = Producer (Map ChrId (Array a)) (Aff eff) Unit

-- Feels like this one takes care of a bit too much...
fetchLoop1 :: forall a.
              (Maybe (Aff _ (TrackProducer _ a)))
           -> Aff _ (TrackVar a)
fetchLoop1 Nothing = AVar.makeEmptyVar
fetchLoop1 (Just startProd) = do
  prod <- startProd
  avar <- makeVar mempty
  _ <- forkAff $ runProcess $ prod `connect` chunkConsumer avar
  pure avar

-- | Starts threads that fetch & parse each of the provided tracks,
-- | filling an AVar over time per track, which can be used by other parts of the application
-- | (read only, should be a newtype)
fetchLoop :: CoordSys ChrId BigInt
          -> DataURLs
          -> Aff _
               { gwas :: TrackVar (GWASFeature ())
               , genes :: TrackVar BedFeature
               , annotations :: TrackVar (Annot ())
               }
fetchLoop cs urls = do
  gwas <-        fetchLoop1 $ produceGWAS   cs <$> urls.gwas
  annotations <- fetchLoop1 $ produceAnnots cs <$> urls.annotations
  genes <-       fetchLoop1 $ produceGenes  cs <$> urls.genes
  pure { gwas, genes, annotations }

module Genetics.Browser.Track.UI where

import Prelude

import Color (black)
import Color.Scheme.Clrs (blue, red)
import Control.Coroutine (Consumer, Producer, connect, runProcess)
import Control.Coroutine as Co
import Control.Monad.Aff (Aff, Fiber, Milliseconds(..), delay, finally, forkAff, killFiber, launchAff, launchAff_)
import Control.Monad.Aff.AVar (AVar, makeEmptyVar, makeVar, putVar, readVar, takeVar, tryTakeVar)
import Control.Monad.Aff.AVar as AVar
import Control.Monad.Eff (Eff, forE, foreachE)
import Control.Monad.Eff.Class (liftEff)
import Control.Monad.Eff.Console (log)
import Control.Monad.Eff.Exception (error)
import Control.Monad.Eff.Random (random, randomRange)
import Control.Monad.Eff.Uncurried (EffFn4, runEffFn4)
import Control.Monad.Error.Class (throwError)
import Control.Monad.Rec.Class (forever)
import DOM.Classy.Node (toNode)
import DOM.Classy.ParentNode (toParentNode)
import DOM.HTML (window) as DOM
import DOM.HTML.Types (htmlDocumentToDocument) as DOM
import DOM.HTML.Window (document) as DOM
import DOM.Node.Element as DOM
import DOM.Node.Node (appendChild) as DOM
import DOM.Node.ParentNode (querySelector) as DOM
import DOM.Node.Types (Element, Node)
import Data.Argonaut (Json, _Number, _Object, _String)
import Data.Array as Array
import Data.Bifunctor (bimap)
import Data.BigInt (BigInt)
import Data.BigInt as BigInt
import Data.Either (Either(..), note)
import Data.Filterable (filter)
import Data.Foldable (class Foldable, foldMap, for_, null)
import Data.Foreign (Foreign, MultipleErrors, renderForeignError)
import Data.Lens (to, (^.), (^?))
import Data.Lens.Index (ix)
import Data.List (List)
import Data.List as List
import Data.Map (Map)
import Data.Maybe (Maybe(Just, Nothing), fromJust, fromMaybe)
import Data.Monoid (class Monoid, mempty)
import Data.Newtype (ala, over, unwrap, wrap)
import Data.Nullable (Nullable, toMaybe)
import Data.Pair (Pair(..))
import Data.Symbol (SProxy(..))
import Data.Traversable (for, traverse, traverse_)
import Data.Tuple (Tuple(Tuple))
import Genetics.Browser.Track.Backend (Padding, RenderedTrack, browser, bumpFeatures, zipMapsWith)
import Genetics.Browser.Track.Demo (Annot, BedFeature, GWASFeature, annotLegendTest, demoTracks, getAnnotations, getGWAS, getGenes, gwasDraw, gwasGlyphTest, produceAnnots, produceGWAS, produceGenes)
import Genetics.Browser.Track.UI.Canvas (BrowserCanvas, TrackPadding, blankTrack, browserCanvas, debugBrowserCanvas, drawOnTrack, flipTrack, renderBatchGlyphs, renderBrowser, renderSingleGlyphs, renderTrack, trackViewScale, transTrack)
import Genetics.Browser.Types (Bp(..), ChrId(ChrId), Point)
import Genetics.Browser.Types.Coordinates (CoordSys(..), CoordSysView(..), ViewScale(..), _TotalSize, coordSys, normalizeView, pairSize, pixelsView, scalePairBy, scaleViewBy, translatePairBy, translateViewBy)
import Global.Unsafe (unsafeStringify)
import Graphics.Canvas (CanvasElement, Context2D, fillRect, getContext2D, setFillStyle)
import Graphics.Canvas as Canvas
import Graphics.Drawing (Drawing, fillColor, filled, rectangle, white)
import Graphics.Drawing as Drawing
import Partial.Unsafe (unsafeCrashWith, unsafePartial)
import Simple.JSON (read, readJSON)
import Unsafe.Coerce (unsafeCoerce)

foreign import windowInnerSize :: forall e.
                                  Eff e Canvas.Dimensions

-- | Set an event to fire on the given button id
foreign import buttonEvent :: forall eff.
                              String
                           -> Eff eff Unit
                           -> Eff eff Unit

type ViewRange = Pair BigInt

data UpdateView =
    ScrollView Number
  | ZoomView Number
  | ModView (Pair BigInt -> Pair BigInt)

instance showUpdateView :: Show UpdateView where
  show (ScrollView x) = "(Scroll by " <> show x <> ")"
  show (ZoomView s) = "(Zoom by " <> show s <> ")"
  show _ = "(ModView)"

    -- TODO idk if this instance makes sense??? whatevs
instance semigroupUpdateView :: Semigroup UpdateView where
  append (ScrollView x1) (ScrollView x2) = ScrollView (x1 + x2)
  append (ZoomView s1)   (ZoomView s2)   = ZoomView   (s1 * s2)
  append _ y = y

instance monoidUpdateView :: Monoid UpdateView where
  mempty = ModView id

updateViewFold :: UpdateView
               -> CoordSysView
               -> CoordSysView
updateViewFold uv iv = case uv of
  ZoomView   x -> iv `scaleViewBy`     x
  ScrollView x -> iv `translateViewBy` x
  ModView f    -> over CoordSysView f iv

queueCmd :: AVar UpdateView -> UpdateView -> Eff _ Unit
queueCmd av cmd = launchAff_ $ putVar cmd av

btnScroll :: Number -> AVar UpdateView -> Eff _ Unit
btnScroll x av = do
  buttonEvent "scrollLeft"  $ queueCmd av $ ScrollView (-x)
  buttonEvent "scrollRight" $ queueCmd av $ ScrollView   x

btnZoom :: Number -> AVar UpdateView -> Eff _ Unit
btnZoom x av = do
  buttonEvent "zoomOut" $ queueCmd av $ ZoomView $ 1.0 + x
  buttonEvent "zoomIn"  $ queueCmd av $ ZoomView $ 1.0 - x

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

-- runs console.time() with the provided string, returns the effect to stop the timer
foreign import timeEff :: forall eff. String -> Eff eff (Eff eff Unit)

type UIState e = { view :: AVar CoordSysView
                 , viewCmd :: AVar UpdateView
                 , viewReady :: AVar Unit
                 , renderFiber :: AVar (Fiber e Unit)
                 , cachedTracks :: AVar { cachedScale :: ViewScale
                                        , glyphs :: List (Array RenderedTrack) }
                 }

uiViewUpdate :: forall r.
                CoordSys _ BigInt
             -> Milliseconds
             -> { view :: AVar CoordSysView
                , viewCmd :: AVar UpdateView
                , viewReady :: AVar Unit| r }
             -> Aff _ Unit
uiViewUpdate cs timeout { view, viewCmd, viewReady } = do
  curCmdVar <- makeVar mempty

  let normView = normalizeView cs (BigInt.fromInt 2000)

      loop' updater = do
        cmd <- takeVar viewCmd

        killFiber (error "Resetting view update") updater

        curCmd <- takeVar curCmdVar
        let cmd' = curCmd <> cmd
        putVar cmd' curCmdVar

        updater' <- forkAff do
            delay timeout
            vr <- takeVar view
            putVar (updateViewFold cmd' vr) view
            -- putVar (normView $ updateViewFold cmd' vr) view
            putVar unit viewReady
            takeVar curCmdVar *> putVar mempty curCmdVar

        loop' updater'

  loop' (pure unit)

renderLoop :: CoordSys _ _
           -> { tracks     :: Pair BigInt -> List (Array RenderedTrack)
              , relativeUI :: Pair BigInt -> Drawing
              , fixedUI :: Drawing }
           -> BrowserCanvas
           -> UIState _
           -> Aff _ Unit
renderLoop cSys browser canvas state = forever do

  _ <- takeVar state.viewReady

  csView <- readVar state.view
  -- if there's a rendering fiber running, we kill it
  traverse_ (killFiber (error "Resetting renderer"))
    =<< tryTakeVar state.renderFiber

  let uiScale = trackViewScale canvas csView

  -- if the view scale is unchanged, use the cached glyphs
  tracks' <- do
    cache <- AVar.tryTakeVar state.cachedTracks
    case cache of
      Just ct
        | ct.cachedScale == uiScale -> do
            AVar.putVar ct state.cachedTracks
            pure ct.glyphs
      _ -> do
        let cachedScale = uiScale
            glyphs = browser.tracks (unwrap csView)

        AVar.putVar {cachedScale, glyphs} state.cachedTracks
        pure glyphs

  -- fork a new renderFiber

  let (Pair offset _) = pixelsView uiScale csView

      relativeUI = browser.relativeUI (unwrap csView)
      fixedUI = browser.fixedUI

      ui ::  { tracks     :: List (Array RenderedTrack)
             , relativeUI :: Drawing
             , fixedUI :: Drawing }
      ui = { tracks: tracks'
           , relativeUI, fixedUI }

  renderFiber <- forkAff
                 $ renderBrowser (wrap 3.0) canvas offset ui

  putVar renderFiber state.renderFiber

-- TODO configure UI widths
runBrowser :: Conf -> BrowserCanvas -> Eff _ _
runBrowser config bc = launchAff $ do

  {width} <- liftEff $ windowInnerSize

  let height = config.browserHeight
      browserDimensions = {width, height}
      vScaleWidth = 60.0
      legendWidth = 120.0
      trackWidth = width - (vScaleWidth + legendWidth)

  let cSys :: CoordSys ChrId BigInt
      cSys = coordSys mouseChrSizes

  trackData <- do
    genes <- traverse (getGenes cSys) config.urls.genes
    gwas  <- traverse (getGWAS  cSys) config.urls.gwas
    rawAnnotations <-
      traverse (getAnnotations cSys) config.urls.annotations

    let annotations = zipMapsWith
                       (bumpFeatures (to _.score) (SProxy :: SProxy "score")
                         (Bp 1000000.0))
                       <$> gwas <*> rawAnnotations

    pure { genes, gwas, annotations }

  let initialView :: CoordSysView
      initialView = wrap $ Pair zero (cSys^._TotalSize)

  viewCmd <- makeEmptyVar
  liftEff $ do
    btnScroll 0.05 viewCmd
    btnZoom   0.10 viewCmd
    -- dragScroll trackWidth bCanvas viewCmd
    -- wheelZoom 0.02 viewCmd bCanvas.overlay

  view <- makeVar initialView
  viewReady <- makeVar unit
  renderFiber <- makeEmptyVar
  cachedTracks <- AVar.makeEmptyVar

  let initState :: UIState _
      initState = { view, viewCmd, viewReady, renderFiber, cachedTracks }

  let
      entries = foldMap annotLegendTest trackData.annotations
      legend = { width: legendWidth, entries }

      s = config.score

      vscale = { width: vScaleWidth, color: black
               , min: s.min, max: s.max, sig: s.sig }

      tracks = demoTracks vscale trackData

      padding = { horizontal: config.trackPadding.left
                , vertical: config.trackPadding.top }

      mainBrowser = browser cSys browserDimensions padding {legend, vscale} tracks

      viewTimeout :: Milliseconds
      viewTimeout = wrap 100.0

  _ <- forkAff $ uiViewUpdate cSys viewTimeout initState
  _ <- forkAff $ renderLoop cSys mainBrowser bc initState

  pure unit

type DataURLs = { gwas        :: Maybe String
                , annotations :: Maybe String
                , genes       :: Maybe String
                }

type Conf = { browserHeight :: Number
            , trackPadding :: TrackPadding
            , score :: { min :: Number, max :: Number, sig :: Number }
            , urls :: DataURLs
            }

foreign import setWindow :: forall e a. String -> a -> Eff e Unit

initBrowser :: Foreign -> Eff _ _
initBrowser rawConfig = do

  el' <- do
    doc <- DOM.htmlDocumentToDocument
           <$> (DOM.document =<< DOM.window)
    DOM.querySelector (wrap "#browser") (toParentNode doc)

  case read rawConfig :: Either MultipleErrors Conf of
    Left errs -> traverse_ (log <<< renderForeignError) errs
    Right c   -> do
      case el' of
        Nothing -> log "Could not find element '#browser'"
        Just el -> do

          {width} <- windowInnerSize
          let dimensions = { width, height: c.browserHeight }
          bc <- browserCanvas dimensions c.trackPadding el

          debugBrowserCanvas "debugBC" bc

          let drawR :: Number -> Number -> Eff _ Unit
              drawR x y = drawOnTrack bc \ctx -> do
                _ <- setFillStyle "red" ctx
                _ <- fillRect ctx { x, y, w: 20.0, h: 20.0 }
                pure unit

          setWindow "drawRect" drawR
          setWindow "flipTrack" (flipTrack bc)
          setWindow "blankTrack" (blankTrack bc)

          log $ unsafeStringify c
          void $ runBrowser c bc

-- TODO this could almost certainly be done better
chunkConsumer :: forall m a.
                 Foldable m
              => Monoid (m a)
              => AVar (m a)
              -> Consumer (m a) (Aff _) Unit
chunkConsumer av = Co.consumer \m ->
  if null m
     then pure $ Just unit
     else do
       sofar <- takeVar av
       putVar (sofar <> m) av
       delay (wrap 20.0)
       pure Nothing

type TrackVar a = AVar (Map ChrId (Array a))
type TrackProducer eff a = Producer (Map ChrId (Array a)) (Aff eff) Unit

-- Feels like this one takes care of a bit too much...
fetchLoop1 :: forall a.
              (Maybe (Aff _ (TrackProducer _ a)))
           -> Aff _ (TrackVar a)
fetchLoop1 Nothing = AVar.makeEmptyVar
fetchLoop1 (Just startProd) = do
  prod <- startProd
  avar <- makeVar mempty
  _ <- forkAff $ runProcess $ prod `connect` chunkConsumer avar
  pure avar

-- | Starts threads that fetch & parse each of the provided tracks,
-- | filling an AVar over time per track, which can be used by other parts of the application
-- | (read only, should be a newtype)
fetchLoop :: CoordSys ChrId BigInt
          -> DataURLs
          -> Aff _
               { gwas :: TrackVar (GWASFeature ())
               , genes :: TrackVar BedFeature
               , annotations :: TrackVar (Annot ())
               }
fetchLoop cs urls = do
  gwas <-        fetchLoop1 $ produceGWAS   cs <$> urls.gwas
  annotations <- fetchLoop1 $ produceAnnots cs <$> urls.annotations
  genes <-       fetchLoop1 $ produceGenes  cs <$> urls.genes
  pure { gwas, genes, annotations }


Reimplement (poor) button-based UI; buggy but functional drag-scroll

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.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, drawDemo', getDataDemo, mouseChrIds)
import Genetics.Browser.Types (Bp(..), BrowserPoint(..), ChrId(..), CoordSys(..), Interval(..), IntervalPoint, LocalPoint(..), Point, canvasToBrowserOffset, canvasToView, frameToChr, globalToFrame, intervalSize, localToGlobal, 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 BigInt
  | Zoom (Ratio BigInt)
  | ScrollView (Ratio BigInt)
  | NoOp

btnScroll :: forall r.
             BigInt
          -> 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 :: BigInt, 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 :: BrowserPoint
           -> BigInt
           -> BrowserView
           -> BrowserView
scrollView (BPoint size) p (Interval (BPoint l) (BPoint r)) =
  let p' = p
  in Interval (BPoint $ max zero (l - p')) (BPoint $ min size (r - p'))

scrollViewGood :: Ratio BigInt
               -> BrowserView
               -> BrowserView
scrollViewGood rat iv@(Interval (BPoint l) (BPoint r)) =
  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 (Interval (BPoint lhs) (BPoint rhs))
              (Interval (BPoint l)   (BPoint r)) = Interval (BPoint $ max lhs l) (BPoint $ min r rhs)

updateViewFold :: { size :: _, scroll :: _, zoom :: _ }
               -> UpdateView
               -> BrowserView
               -> BrowserView
-- updateViewFold _ iv = iv
updateViewFold ssz uv iv@(Interval l r) = case uv of
  Scroll p  -> scrollView ssz.size p iv
  Zoom r    -> zoomView ssz.size r iv
  ScrollView x -> scrollViewGood x iv
  _ -> iv

browserViewEvent :: { size :: BrowserPoint, scroll :: _, zoom :: _ }
                 -> BrowserView
                 -> Event UpdateView
                 -> Event BrowserView
browserViewEvent ssz start ev = Event.fold (\a b -> (normalizeView start) (updateViewFold ssz 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 -> localToGlobal $ Local iv r) <$> vs <*> vx

frameClick :: CoordSys ChrId BrowserPoint -> Event BrowserPoint -> Event (Maybe (Tuple ChrId IntervalPoint))
frameClick csys = map (globalToFrame csys)

chrClick :: CoordSys ChrId BrowserPoint
         -> Event (Maybe (Tuple ChrId IntervalPoint))
         -> Event (Maybe (Tuple ChrId Bp))
chrClick csys ev = f <$> ev
  where f x = do
          p@(Tuple i _) <- x
          Tuple i <$> frameToChr csys p

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

showLP :: IntervalPoint -> String
showLP (Local 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
                in x' % width

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

  -- let cDrag = canvasDrag canvas
  --     lefts = case _ of
  --       Left x -> Just x
  --       Right _ -> Nothing
  --     -- the alt operator <|> combines the two event streams,
  --     -- resulting in an event of both button-click scrolls
  --     -- and canvas-drag scrolls

      -- dragScroll = filterMap (map (ScrollPixels <<< _.x) <<< lefts) cDrag
      -- updateViews = btnScroll (Bp 500.0)
      --           <|> dragScroll
      --           <|> btnZoom (wrap <<< (_ * 0.8) <<< unwrap)
      --                       (wrap <<< (_ * 1.2) <<< unwrap)
      --           <|> scrollZoom canvas
      -- viewB = FRP.fold foldView updateViews v

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

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 :: BigInt
      scroll = 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 = Interval (BPoint $ BigInt.fromInt 652428823) s.size

      viewEvent :: Event (Interval BrowserPoint)
      viewEvent = browserViewEvent {size: s.size, scroll, zoom } begin
                    $ btnUpdateView {scroll: 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 (Tuple chr i)) = "Frame: " <> show chr <> showLP i
               sF Nothing = "No Frame"
               sChr (Just (Tuple chr bp)) = "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 = 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 (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.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 FRP.Event (Event)
import FRP.Event as Event
import FRP.Event as FRP
import Genetics.Browser.Track.Backend (GWASFeature, Gene, drawDemo, drawDemo', getDataDemo, mouseChrIds)
import Genetics.Browser.Types (Bp(..), BrowserPoint(..), ChrId(..), CoordSys(..), Interval(..), IntervalPoint, LocalPoint(..), Point, canvasToBrowserOffset, canvasToView, frameToChr, globalToFrame, intervalSize, localToGlobal, mkCoordSys)
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)
  | NoOp

-- btnScroll :: Event UpdateView
-- btnScroll = const GoLeft  <$> buttonEvent "scrollLeft" <|>
--             const GoRight <$> buttonEvent "scrollRight"

-- btnZoom :: Event UpdateView
-- btnZoom = const Out <$> buttonEvent "zoomOut" <|>
--           const In  <$> buttonEvent "zoomIn"

-- btnUpdateView :: Event UpdateView
-- btnUpdateView = btnScroll <|> btnZoom <|> (const NoOp <$> buttonEvent "redraw")

scrollView :: BrowserPoint
           -> BrowserView
           -> BrowserView
scrollView (BPoint p) (Interval (BPoint l) (BPoint r)) =
  Interval (BPoint $ l - p) (BPoint $ r - p)

zoomView :: Ratio BigInt
         -> BrowserView
         -> BrowserView
zoomView (BPoint p) iv@(Interval (BPoint l) (BPoint r)) = iv

updateViewFold :: UpdateView
               -> BrowserView
               -> BrowserView
updateViewFold uv iv@(Interval l r) of
  Scroll p  -> scrollView p iv
  Zoom r    -> zoomView r iv
  NoOp -> iv

browserViewEvent :: BrowserView
                 -> Event UpdateView
                 -> Event BrowserView
browserViewEvent start ev = Event.fold updateViewFold ev start

drawingEvent :: { min :: Number, max :: Number }
             -> CoordSys ChrId BrowserPoint
             -> { width :: Pixels, height :: Pixels, padding :: Pixels, yOffset :: Pixels }
             -> { gwas  :: Map ChrId (List _)
                , annots :: Map ChrId (List _) }
             -> Event BrowserView
             -> Event Drawing
drawingEvent s box dat = let dd = drawDemo' 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 -> localToGlobal $ Local iv r) <$> vs <*> vx

frameClick :: CoordSys ChrId BrowserPoint -> Event BrowserPoint -> Event (Maybe (Tuple ChrId IntervalPoint))
frameClick csys = map (globalToFrame csys)

chrClick :: CoordSys ChrId BrowserPoint
         -> Event (Maybe (Tuple ChrId IntervalPoint))
         -> Event (Maybe (Tuple ChrId Bp))
chrClick csys ev = f <$> ev
  where f x = do
          p@(Tuple i _) <- x
          Tuple i <$> frameToChr csys p

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

showLP :: IntervalPoint -> String
showLP (Local 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 (Interval BrowserPoint)
            -> Event Number
            -> Event BrowserPoint
browserDrag w v ev = canvasToBrowserOffset w
                     <$> map intervalSize v
                     <*> ev

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 = canvasDrag canvas

  let viewEvent :: Event (Array ChrId)
      viewEvent = chrsArrayEvent $ chrZREvent mouseChrIds btnUpdateView

      viewEv' :: Event (Interval BrowserPoint)
      viewEv' = viewRange coordSys viewEvent

      click :: Event Pixels
      click = clickEvent canvas

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

      gClick :: Event BrowserPoint
      gClick = globalClick viewEv' vClick

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

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

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

  void $ liftEff $ Event.subscribe clickEvs
       (\ev -> do
           let sF (Just (Tuple chr i)) = "Frame: " <> show chr <> showLP i
               sF Nothing = "No Frame"
               sChr (Just (Tuple chr bp)) = "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, padding: 10.0, yOffset: 5.0}
      score = {min: 0.125, max: 0.42}

  let ev' = drawingEvent score 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 = 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")
            ]