diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog for vega-view +## 0.2 + +The directory view now displays all the visualizations in a directory, +and hides those files that are not JSON. Selecting a visualization can +now open it in a new page (0.1 behavior) or inline (new). + ## 0.1 Initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,10 @@ # vega-view I am not 100% convinced this is a worthwhile project, but let's see how -it goes. +it goes. You can think of it as "I want +[vega desktop](https://github.com/vega/vega-desktop) but don't want +to install an electron application, so decided to write an inferior +product" project. The aim is to make it easy to view [Vega](https://vega.github.io/vega/) @@ -25,6 +28,15 @@ on port 8082 that can be used to view them at the URL http://localhost:8082/display/ + +Visualizations can either be viewed as their own "page", or inline, +which may be more useful when you have multiple plots to view. + +The aim is to be run in a a directory structure where most, if not +all, the files are Vega or Vega-Lite specifications. This means that +the web server tries to parse each file as JSON, which could cause +memory- or time- issues if there are large non-JSON files in the +directory tree. ## GHC support diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -23,16 +23,20 @@ import Control.Exception (IOException, try) import Control.Monad (forM_, unless) import Control.Monad.IO.Class (liftIO) -import Data.Aeson (Value(String, Object), Object, eitherDecode', encode) +import Data.Aeson (Value(String, Object), Object + , (.=) + , eitherDecode', encode, object) import Data.List (sort) +import Data.Maybe (catMaybes) import Data.Version (showVersion) import Network.HTTP.Types (status404) import System.Directory (doesDirectoryExist, listDirectory) -import System.FilePath ((), takeDirectory) +import System.FilePath ((), takeBaseName, takeDirectory) import Text.Blaze.Html5 ((!)) import Text.Blaze.Html.Renderer.Text (renderHtml) import Web.Scotty (ScottyM, ActionM - , get, html, notFound, param + , get, html, json + , notFound, param , redirect, regex , status, scotty , text) @@ -115,6 +119,19 @@ Right _ -> Left "JSON was not an object" Left e -> Left e + +-- | Return a HTML block (a div) that will dislay the visualization, +-- if the file is a JSON object (but not guaranteed to be a Vega or +-- Vega-Lite spec). The id of the visualization is based on the +-- file name, so it is assumed to be unique for the page. +-- +makeSpec :: FilePath -> IO (Maybe H.Html) +makeSpec infile = do + espec <- readSpec infile + case espec of + Left _ -> pure Nothing + Right s -> pure (Just (createView s (takeBaseName infile))) + indexPage :: H.Html indexPage = @@ -131,29 +148,236 @@ , " to see the available visualizations." ]) + +-- Return the directories in ths directory, and the JSON files we +-- can try displaying. All other files are dropped. +-- +getFileContents :: + FilePath + -> IO ([FilePath], [(FilePath, H.Html)]) + -- ^ First we list the directories in ths directory, and then the + -- displayable contents. Either list can be empty. + -- +getFileContents indir = do + + infiles <- sort <$> listDirectory indir + dirFlags <- mapM doesDirectoryExist infiles + + let files = zip dirFlags infiles + + -- these are not expected to be large lists so any duplicated effort + -- is not large; also, rely on the power of the compiler to fuse + -- everything + -- + dirNames = map snd (filter fst files) + otherNames = map snd (filter (not . fst) files) + + go f = do + mspec <- makeSpec f + case mspec of + Just h -> pure (Just (f, h)) + _ -> pure Nothing -dirPage :: FilePath -> ActionM () -dirPage indir = do - infiles <- liftIO (listDirectory indir) + mspecs <- mapM go otherNames + let specs = catMaybes mspecs + + pure (dirNames, specs) + + +pageLink :: FilePath -> FilePath -> H.Html +pageLink indir infile = + let toHref = H.toValue ("/display" indir infile) + in (H.a ! A.href toHref) (H.toHtml infile) + +makeLi :: FilePath -> FilePath -> H.Html +makeLi indir infile = H.li (pageLink indir infile) + +embedLink :: FilePath -> FilePath -> H.Html +embedLink indir infile = + let toHref = H.toValue ("/embed" indir infile) + hdlr = "embed('" <> toHref <> "');" + + in (H.a ! A.href "#" ! A.onclick hdlr) (H.toHtml infile) + +-- Nothing to see here; slightly different if base directory or not +emptyDir :: FilePath -> ActionM () +emptyDir indir = + let page = (H.docTypeHtml ! A.lang "en-US") $ do + H.head (H.title (H.toHtml ("Files to view: " ++ indir))) + H.body $ do + H.h1 "Vega and Vega-Lite viewer" + + if indir == "." + then H.p "There is nothing to see in the base directory!" + else do + H.p (H.toHtml ("Directory: " ++ indir)) + H.p "There is nothing to see here!" + H.ul (makeLi indir "..") + + in html (renderHtml page) + + +-- Code to display a specification inline +-- +-- Would be a lot nicer to embed the code from a file at build time +-- or to load at run time. +-- +-- TODO: set max width/height of the visualization window so that +-- overflow works? Not obvious best way to do this. +-- +-- TODO: allow the user to drag the window around +-- +inlineJS :: H.Html +inlineJS = + let cts = [ "function embed(path) { " + , "var req = new XMLHttpRequest(); " + , "req.addEventListener('load', embedSpec); " + , "req.responseType = 'json'; " + , "req.open('GET', path); " + , "req.send(); " + , "} " + , "function embedSpec(e) { " + , "const div = document.getElementById('vizview'); " + , "while (div.firstChild) { " + , "div.removeChild(div.firstChild);" + , "} " + , "const tgt = e.target; " + , "if (tgt.status == 200) { " + , "addTitle(div, tgt.response.infile); " + , "addDescription(div, tgt.response.spec); " + , "const vdiv = document.createElement('div'); " + , "div.appendChild(vdiv); " + , "vegaEmbed(vdiv, tgt.response.spec); " + , "} else { " + , "addText(div, 'Unable to load specification'); " + , "} " + , "div.style.display = 'block';" + , "} " + , "function addText(parent, text) { " + , "parent.appendChild(document.createTextNode(text)); " + , "} " + , "function addTitle(div, infile) { " + , "const el = document.createElement('p'); " + , "el.setAttribute('class', 'location'); " + , "addText(el, 'File: ' + infile); " + , "div.appendChild(el); " + , "const close = document.createElement('span'); " + , "close.setAttribute('class', 'close'); " + , "addText(close, '[X]'); " + , "el.appendChild(close); " + , "close.addEventListener('click', (ev) => { " + , "div.style.display = 'none'; " + , "while (div.firstChild) { " + , "div.removeChild(div.firstChild);" + , "} " + , "});" + , "}" + , "function addDescription(div, spec) { " + , "if (!spec.description || spec.description === '') { return; } " + , "const el = document.createElement('p'); " + , "el.setAttribute('class', 'description'); " + , "addText(el, spec.description); " + , "div.appendChild(el); " + , "}" + ] + in (H.script ! A.type_ "text/javascript") (mconcat cts) + + +inlineCSS :: H.Html +inlineCSS = + let cts = [ "#vizview { " + , "background: white; " + , "border: 2px solid rgba(0, 0, 0, 0.6); " + , "display: none; " + , "left: 2em; " + , "overflow: hidden; " + , "padding: 1em; " + , "position: fixed; " + , "top: 2em; " + , "} " + , "p.location { " + , "background: rgba(0, 0, 0, 0.2);" + , "font-weight: bold; " + , "margin: -1em; " + , "margin-bottom: 1em; " + , "padding: 0.5em; " + , "} " + , ".close { " + , "float: right; " + , "}" + ] + in (H.style ! A.type_ "text/css") (mconcat cts) + + +showDir :: + FilePath + -> ([FilePath], [(FilePath, H.Html)]) + -> ActionM () +showDir indir (subdirs, files) = let atTop = indir == "." page = (H.docTypeHtml ! A.lang "en-US") $ do - H.head (H.title (H.toHtml ("Files to view: " ++ indir))) + H.head $ do + H.title (H.toHtml ("Files to view: " ++ indir)) + vegaEmbed + inlineJS + inlineCSS + H.body $ do H.h1 "Vega and Vega-Lite viewer" unless atTop (H.p (H.toHtml ("Directory: " ++ indir))) - H.ul $ do - unless atTop (makeLi "..") - forM_ (sort infiles) makeLi - toHref infile = H.toValue ("/display" indir infile) - - makeLi infile = H.li $ (H.a ! A.href (toHref infile)) (H.toHtml infile) + unless (null subdirs) $ do + H.h2 "Sub-directories" + H.ul $ do + unless atTop (makeLi indir "..") + forM_ subdirs (makeLi indir) - html (renderHtml page) + -- let's see how this basic setup works + -- + -- TODO: might be nice to let users easily skip to next or + -- previous visualization when viewing one. + -- + unless (null files) $ do + (H.div ! A.id "vizview") "" + (H.div ! A.id "vizlist") $ do + H.h2 "Visualizations" + H.table $ do + H.thead $ + H.tr $ do + H.th "View page" + H.th "View inline" + H.tbody $ + forM_ files $ \(f, _) -> + H.tr $ do + H.td (pageLink indir f) + H.td (embedLink indir f) + in html (renderHtml page) + +dirPage :: FilePath -> ActionM () +dirPage indir = do + + files <- liftIO (getFileContents indir) + case files of + ([], []) -> emptyDir indir + _ -> showDir indir files + + +-- load up vega embed +vegaEmbed :: H.Html +vegaEmbed = + let load n = H.script ! A.src (mconcat [ "https://cdn.jsdelivr.net/npm/" + , n]) + + in do + load "vega@5" "" + load "vega-lite@3" "" + load "vega-embed@4" "" + + showPage :: FilePath -> ActionM () showPage infile = do espec <- liftIO (readSpec infile) @@ -165,24 +389,19 @@ -- information leak from this. -- text (LT.pack emsg) - status status404 + errorStatus Right spec -> let contents = createView spec "vega-vis" page = (H.docTypeHtml ! A.lang "en-US") $ do H.head $ do H.title "View a spec" - load "vega@5" "" - load "vega-lite@3" "" - load "vega-embed@4" "" + vegaEmbed H.body $ do H.h1 "View Vega or Vega-Lite with Vega Embed" H.p $ H.toHtml (mconcat ["Go to ", parentLink]) contents - load n = H.script ! A.src (mconcat [ "https://cdn.jsdelivr.net/npm/" - , n]) - dirName = H.toValue ("/display" takeDirectory infile) parentLink = (H.a ! A.href dirName) "parent directory" @@ -197,6 +416,22 @@ else showPage infile +-- Return data needed to display this file. +-- +embedPage :: FilePath -> ActionM () +embedPage infile = do + espec <- liftIO (readSpec infile) + case espec of + Right (Spec o _) -> json (object [ "spec" .= Object o + , "infile" .= infile + ]) + _ -> errorStatus + + +errorStatus :: ActionM () +errorStatus = status status404 + + webapp :: ScottyM () webapp = do @@ -210,9 +445,11 @@ infile <- param "1" displayPage infile - notFound $ do - status status404 - pure () + get (regex "^/embed/(.+)$") $ do + infile <- param "1" + embedPage infile + + notFound errorStatus -- for now assume current directory diff --git a/vega-view.cabal b/vega-view.cabal --- a/vega-view.cabal +++ b/vega-view.cabal @@ -1,5 +1,5 @@ name: vega-view -version: 0.1.0.0 +version: 0.2.0.0 description: Please see the README on GitHub at homepage: https://github.com/DougBurke/vega-view#readme bug-reports: https://github.com/DougBurke/vega-view/issues