vega-view (empty) → 0.1.0.0
raw patch · 6 files changed
+337/−0 lines, 6 filesdep +aesondep +basedep +blaze-htmlsetup-changed
Dependencies added: aeson, base, blaze-html, bytestring, directory, filepath, http-types, scotty, text, unordered-containers
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- README.md +38/−0
- Setup.hs +2/−0
- app/Main.hs +220/−0
- vega-view.cabal +42/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Changelog for vega-view++## 0.1++Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Douglas Burke (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,38 @@+# vega-view++I am not 100% convinced this is a worthwhile project, but let's see how+it goes.++The aim is to make it easy to view+[Vega](https://vega.github.io/vega/)+and+[Vega-Lite](https://vega.github.io/vega-lite/)+specifications - i.e. the JSON representing a visualization - as+a visualization. It relies on+[Vega Embed](https://github.com/vega/vega-embed) to do all+the hard work, and just provides a basic web server that will list the+files in a given directory and, when selected, create the+call to Vega Embed.++## License++This is released under a BSD3 license.++## Usage++The server - called `vega-view` - should be run from the directory+containing the specifications to view. It then provides a web server+on port 8082 that can be used to view them at the URL++ http://localhost:8082/display/++## GHC support++This is currently a **very basic** application, so will hopefully build+against a wide variety of GHC installations. There has been /no/ testing+on Windows.++## Bugs and Issues++Please use the [issues list](https://github.com/DougBurke/vega-view/issues)+to report any problems.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,220 @@+{-# LANGUAGE OverloadedStrings #-}++{-+A very-basic viewer for Vega and Vega-Lite specfications. You+can browse from the current working directory, and view any+individual specification via Vega Embed (or an error if it isn't+a JSON file or some other issue).++A drag-and-drop page could be added, as could and endpoint to which+you post a specification.++The code could be refactored to be a SPA.++-}+module Main where++import qualified Data.ByteString.Lazy.Char8 as LB8+import qualified Data.HashMap.Strict as HM+import qualified Data.Text.Lazy as LT+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A++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.List (sort)+import Data.Version (showVersion)+import Network.HTTP.Types (status404)+import System.Directory (doesDirectoryExist, listDirectory)+import System.FilePath ((</>), takeDirectory)+import Text.Blaze.Html5 ((!))+import Text.Blaze.Html.Renderer.Text (renderHtml)+import Web.Scotty (ScottyM, ActionM+ , get, html, notFound, param+ , redirect, regex+ , status, scotty+ , text)++import Paths_vega_view (version)++-- Represent a Vega or Vega-Lite sepcification, which has+-- to be a Javascript object. Other than checking that we+-- have an object, there is no other validation of the+-- JSON.+--+data Spec = Spec {+ specVis :: Object+ , specPath :: FilePath+ }+++-- Create HTML for the given specification+--+createView ::+ Spec+ -- ^ This is assumed to be Vega or Vega-Lite specification, but+ -- no check is made.+ --+ -- The description field is used if present.+ -> String+ -- ^ The id for the Vega-Embed visualization div.+ -> H.Html+ -- ^ The Html code needed to display this visualization+ -- (assumes vega-embed is already available).+createView spec specId =+ let vis = specVis spec++ mDesc = case HM.lookup "description" vis of+ Just (String d) -> Just d+ _ -> Nothing++ jsCts = mconcat [ "vegaEmbed('#"+ , H.toHtml specId+ , "', "+ , H.toHtml (LB8.unpack (encode vis))+ , ");"]++ in (H.div ! A.class_ "spec") $ do+ (H.p ! A.class_ "location") (H.toHtml (specPath spec))+ + case mDesc of+ Just desc -> (H.p ! A.class_ "description") (H.toHtml desc)+ Nothing -> pure ()++ (H.div ! A.class_ "embed" ! A.id (H.toValue specId)) ""+ (H.script ! A.type_ "text/javascript") jsCts+++readJSON ::+ FilePath+ -- ^ The path to the file. This *must* be relative to the+ -- current working directory.+ -> IO (Either String Value)+readJSON infile = do+ ans <- try (LB8.readFile infile)+ pure $ case ans of+ Left e -> Left (showIOException e)+ Right v -> eitherDecode' v+++showIOException :: IOException -> String+showIOException = show++ +readSpec ::+ FilePath+ -- ^ The path to the file. This *must* be relative to the+ -- current working directory.+ -> IO (Either String Spec)+readSpec infile = do+ cts <- either (Left . show) Right <$> readJSON infile+ pure $ case cts of+ Right (Object o) -> Right (Spec o infile)+ Right _ -> Left "JSON was not an object"+ Left e -> Left e++ +indexPage :: H.Html+indexPage =+ H.docTypeHtml ! A.lang "en-US" $ do+ H.head (H.title "View a Vega or Vega-Lite specification")++ H.body $ do+ H.h1 "View a Vega or Vega-Lite specification."++ H.p (mconcat [ "This is version "+ , H.toHtml (showVersion version)+ , " of vega-view. Go to "+ , (H.a ! A.href "/display/") "/display/"+ , " to see the available visualizations."+ ])+ + +dirPage :: FilePath -> ActionM ()+dirPage indir = do+ infiles <- liftIO (listDirectory indir)++ let atTop = indir == "."+ + 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"+ 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)++ html (renderHtml page)+++showPage :: FilePath -> ActionM ()+showPage infile = do+ espec <- liftIO (readSpec infile)+ case espec of+ Left emsg -> do+ -- This is not very informative, but at least provides the user+ -- with some information. The assumption is that this is running+ -- "locally" so we do not have to worry about any possible+ -- information leak from this.+ --+ text (LT.pack emsg)+ status status404++ 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" ""+ 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"+ + in html (renderHtml page)+ ++displayPage :: FilePath -> ActionM ()+displayPage infile = do+ isDir <- liftIO (doesDirectoryExist infile)+ if isDir+ then dirPage infile+ else showPage infile+ ++webapp :: ScottyM ()+webapp = do++ get "/" (redirect "/index.html")+ get "/index.html" (html (renderHtml indexPage))++ -- TODO: catch errors+ get "/display/" (dirPage ".")++ get (regex "^/display/(.+)$") $ do+ infile <- param "1"+ displayPage infile++ notFound $ do+ status status404+ pure ()+++-- for now assume current directory +main :: IO ()+main = scotty 8082 webapp
+ vega-view.cabal view
@@ -0,0 +1,42 @@+name: vega-view+version: 0.1.0.0+description: Please see the README on GitHub at <https://github.com/DougBurke/vega-view#readme>+homepage: https://github.com/DougBurke/vega-view#readme+bug-reports: https://github.com/DougBurke/vega-view/issues+author: Douglas Burke+maintainer: dburke.gw@gmail.com+copyright: 2019 Douglas Burke+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++cabal-version: 1.12++ +source-repository head+ type: git+ location: https://github.com/DougBurke/vega-view++executable vegaview+ main-is: Main.hs+ other-modules:+ Paths_vega_view+ hs-source-dirs:+ app+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ aeson >= 1.1 && < 1.5+ , base >=4.7 && <5+ , blaze-html >= 0.7 && < 0.10+ , bytestring >= 0.10 && < 0.11+ , directory >= 1.2.5.0 && < 1.4+ , filepath >= 1.4 && < 1.5+ , http-types >= 0.9 && < 0.13+ , scotty >= 0.11 && < 0.12+ , text >= 1.2 && < 1.3+ , unordered-containers >= 0.2 && < 0.3+ + default-language: Haskell2010