Fugly but working

Fugly.hs

{-# LANGUAGE JavaScriptFFI #-}
module Scorch.GHCJS.File
       (
         readFileAsync
       ) where

import           Control.Monad.Trans (liftIO)
import           GHCJS.Types
import           GHCJS.Foreign
import           GHCJS.DOM.File (File)
import           Reflex.Dom (performEventAsync)
import           Reflex.Dom.Class (MonadWidget)

data FileReader_
type FileReader = JSRef FileReader_

foreign import javascript unsafe "$r = new FileReader()"
  js_newFileReader :: IO FileReader

foreign import javascript unsafe "$1.onload = $2"
  js_subscribe :: FileReader -> JSFun (JSString -> IO ()) -> IO ()

foreign import javascript unsafe "$r = $1.result"
  js_result :: FileReader -> JSString

foreign import javascript unsafe "$1.readAsDataURL($2)"
  js_readAsDataURL :: FileReader -> File -> IO ()

foreign import javascript unsafe "console.log($1)"
  js_logFile :: File -> IO ()

foreign import javascript unsafe "console.log($1)"
  js_log :: JSRef a -> IO ()

foreign import javascript unsafe "console.log($1)"
  js_logString :: JSString -> IO ()

readFileAsync' :: [File] -> (String -> IO ()) -> IO ()
readFileAsync' [] cb = return ()
readFileAsync' (file:[]) cb = do
  fr <- js_newFileReader
  js_log fr
  let cb' = (\ s -> do
                let res = js_result fr
                js_logString res
                cb $ fromJSString res)
  cb'' <- syncCallback1 NeverRetain False $ cb'
  js_subscribe fr cb''
  js_logFile file
  js_readAsDataURL fr file

--readFileAsync :: Event t [File] -> Event t String
readFileAsync fileE = do
  performEventAsync $ fmap (\file cb -> liftIO $ readFileAsync' file ((\x -> print x) >> cb)) fileE