packages feed

lightning-haskell (empty) → 0.1.0.2

raw patch · 35 files changed

+2693/−0 lines, 35 filesdep +aesondep +api-builderdep +basesetup-changed

Dependencies added: aeson, api-builder, base, blaze-html, bytestring, data-default-class, free, hspec, http-client, http-client-tls, http-types, lightning-haskell, mtl, network, text, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Connor Moreside (c) 2016++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 Connor Moreside 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lightning-haskell.cabal view
@@ -0,0 +1,104 @@+name:                lightning-haskell+version:             0.1.0.2+synopsis:            Haskell client for lightning-viz REST API+description:         Please see README.md+homepage:            https://github.com/cmoresid/lightning-haskell#readme+license:             BSD3+license-file:        LICENSE+author:              Connor Moreside+maintainer:          connor@moresi.de+copyright:           2016 Connor Moreside+stability:           experimental+category:            Web, Visualization+tested-with:         GHC == 7.10.3, GHC == 8.0.1+build-type:          Simple+cabal-version:       >=1.10+description:+    A Haskell client for lightning-viz server. <http://lightning-viz.org/>++library+  hs-source-dirs:      src+  exposed-modules:     Web.Lightning+                     , Web.Lightning.Session+                     , Web.Lightning.Plots+                     , Web.Lightning.Render+                     , Web.Lightning.Types+                     , Web.Lightning.Types.Lightning+                     , Web.Lightning.Types.Error+                     , Web.Lightning.Types.Visualization+                     , Web.Lightning.Utilities+  other-modules:       Web.Lightning.Routes+                     , Web.Lightning.Plots.Line+                     , Web.Lightning.Plots.Force+                     , Web.Lightning.Plots.Scatter+                     , Web.Lightning.Plots.Matrix+                     , Web.Lightning.Plots.Adjacency+                     , Web.Lightning.Plots.Map+                     , Web.Lightning.Plots.Circle+                     , Web.Lightning.Plots.Histogram+                     , Web.Lightning.Plots.Graph+                     , Web.Lightning.Plots.GraphBundled+                     , Web.Lightning.Plots.Scatter3+                     , Web.Lightning.Types.Session+                     , Web.Lightning.Plots.LineStream+                     , Web.Lightning.Plots.ScatterStream+                     , Web.Lightning.Plots.Volume+  build-depends:       base >= 4.7 && < 5+                     , aeson >= 0.11.2.0 && < 1.0.0.0+                     , blaze-html >= 0.8.1.2+                     , bytestring >= 0.10.6.0+                     , data-default-class >= 0.0.1+                     , free >= 4.12.0+                     , mtl >= 2.2.0+                     , http-client >= 0.4.0+                     , http-client-tls >= 0.2.4.0+                     , http-types >= 0.9.1+                     , network >= 2.6.2.0+                     , text >= 1.2.2.0+                     , transformers >= 0.4.0.0+                     , api-builder == 0.12.*+  ghc-options:         -Wall+  default-language:    Haskell2010++test-suite test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , lightning-haskell+                     , aeson >= 0.11.2.0 && < 1.0.0.0+                     , api-builder == 0.12.*+                     , bytestring >= 0.10.6.0+                     , hspec >= 2.2.0+                     , text >= 1.2.2.0+                     , transformers >= 0.4.0.0+  other-modules:       Web.LightningSpec+                     , Web.Lightning.Types.PlotsSpec+                     , Web.Lightning.UtilitySpec+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++test-suite test-integration+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test-integration+  main-is:             Spec.hs+  build-depends:       base+                     , lightning-haskell+                     , aeson >= 0.11.2.0 && < 1.0.0.0+                     , http-client >= 0.4.0+                     , http-client-tls >= 0.2.4.0+                     , http-types >= 0.9.1+                     , network >= 2.6.2.0+                     , api-builder == 0.12.*+                     , bytestring >= 0.10.6.0+                     , hspec >= 2.2.0+                     , text >= 1.2.2.0+                     , transformers >= 0.4.0.0+  other-modules:       ConfigLightning+                     , Web.Lightning.PlotSpec+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/cmoresid/lightning-haskell
+ src/Web/Lightning.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Web.Lightning+Description : lightning-viz REST API wrapper.+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX+-}++module Web.Lightning+  (+    -- * Lightning Types+    LoginMethod(..)+  , LightningOptions(..)+  , LightningState(..)+    -- * Execute+  , runLightning+  , runLightningWith+  , runResumeLightningtWith+  , interpretIO+  -- * Client configuration+  , defaultLightningOptions+  , setBaseURL+  , setSessionName+  , setSessionId+  , setBasicAuth+  -- * Re-exports+  , APIError(..)+  , module Web.Lightning.Types.Error+  , module Web.Lightning.Types.Lightning+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.IO.Class+import           Control.Monad.Trans.Free+import           Control.Monad.Trans.Reader++import           Data.Aeson+import qualified Data.ByteString               as B+import           Data.Default.Class+import qualified Data.Text                     as T++import           Web.Lightning.Session+import           Web.Lightning.Types.Error+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Utilities++import           Network.HTTP.Client+import           Network.HTTP.Client.TLS++import           Network.API.Builder           as API+--------------------------------------------------------------------------------++-- | Represents the different authentication mechanisms available in+-- the lightning-viz server.+data LoginMethod = Anonymous -- ^ No authentication required+                 | BasicAuth Credentials -- ^ HTTP Basic Authentication+                 deriving (Show)++{- | Username and password pair for authenticating to the lightning-viz server. -}+type Credentials = (B.ByteString, B.ByteString)++instance Default LoginMethod where+  def = Anonymous++-- | Defines the available options for running a lightning action(s).+data LightningOptions =+  LightningOptions { optConnManager :: Maybe Manager+                     -- ^ Re-usable connection manager used during Lightning+                     -- session.+                   , optHostUrl     :: T.Text+                     -- ^ The base lightning-viz server url.+                   , optLoginMethod :: LoginMethod+                     -- ^ The authentication mechanism used to communicate+                     -- with the lightning-viz server.+                   , optSession     :: Maybe Session+                     -- ^ Defines what session to use when creating viaualizations+                     -- on the lightning-viz server. If no session is specified,+                     -- one will be created automatically.+                   }++instance Default LightningOptions where+  def = LightningOptions Nothing defaultBaseURL Anonymous Nothing++-- | Defines the default lightning-viz options.+defaultLightningOptions :: LightningOptions+defaultLightningOptions = def++-- | Sets the base URL of Lightning's API in the given+-- 'LightningOptions' record.+setBaseURL :: T.Text+           -- ^ Fully qualified API base URL+           -> LightningOptions+           -> LightningOptions+setBaseURL url opts = opts { optHostUrl = url }++-- | Sets the name of the session that is nested in the+-- given 'LightningOptions' record.+setSessionName :: T.Text+                  -- ^ The new session name+               -> LightningOptions+               -> LightningOptions+setSessionName n opts@(LightningOptions _ _ _ s) =+  opts { optSession = Just sess }+  where+    sess =+      case s of+        Nothing -> def { snName = Just n }+        Just s' -> s' { snName = Just n }++-- | Sets the session ID of the session nested in the given+-- 'LightningOptions' record.+setSessionId :: T.Text+                -- ^ The new session ID+             -> LightningOptions+             -> LightningOptions+setSessionId i opts@(LightningOptions _ _ _ s) =+  opts { optSession = Just sess }+  where+    sess =+      case s of+        Nothing -> def { snId = i }+        Just s' -> s' { snId = i }++-- | Sets 'BasicAuth' with 'Credentials' as the login method in the+-- given 'LightningOptions' record.+setBasicAuth :: Credentials -> LightningOptions -> LightningOptions+setBasicAuth creds opts = opts { optLoginMethod = BasicAuth creds }++-- | Performs a lightning action (or 'LightningT' transformer actions) with the+-- default lightning options. By default, the lightning-viz server is assumed to+-- be running on http://localhost:3000 and a new session will be created.+runLightning :: MonadIO m+             => LightningT m a+             -> m (Either (APIError LightningError) a)+runLightning = runLightningWith defaultLightningOptions++-- | Performs a lightning action (or 'LightningT' transformer actions) with+-- the specified lightning options.+runLightningWith :: MonadIO m => LightningOptions+                     -> LightningT m a+                     -> m (Either (APIError LightningError) a)+runLightningWith opts lightning =+  dropResume <$> runResumeLightningtWith opts lightning++-- | Runs a specified series of lightning actions.+interpretIO :: MonadIO m => LightningState+                -> LightningT m a+                -> m (Either (APIError LightningError, Maybe (LightningT m a)) a)+interpretIO lstate@(LightningState url _ _ _) (LightningT r) =+  runFreeT (runReaderT r url) >>= \case+    Pure x -> return $ Right x+    Free (WithBaseURL u x n) ->+      interpretIO (lstate { stCurrentBaseURL = u }) x >>= \case+        Left (err, Just resume) ->+          return $ Left (err, Just $ resume >>= LightningT . liftLightningF . n)+        Left (err, Nothing) -> return $ Left (err, Nothing)+        Right res -> interpretIO lstate $ LightningT $ (liftLightningF . n) res+    Free (FailWith x) -> return $ Left (x, Nothing)+    Free (RunRoute route n) ->+      interpretIO lstate $ LightningT $ wrap $ ReceiveRoute route (liftLightningF . n . unwrapJSON)+    Free (SendJSON jsonObj route n) ->+      handleSendJSON route lstate jsonObj >>= \case+        Left err -> return $ Left (err, Just $ LightningT $ wrap $ SendJSON jsonObj route (liftLightningF . n))+        Right x -> interpretIO lstate $ LightningT $ (liftLightningF . n) x+    Free (ReceiveRoute route n) ->+      handleReceive route lstate >>= \case+        Left err -> return $ Left (err, Just $ LightningT $ wrap $ ReceiveRoute route (liftLightningF . n))+        Right x -> interpretIO lstate $ LightningT $ (liftLightningF . n) x++-- | Runs a lightning action using the specified options.+runResumeLightningtWith :: MonadIO m => LightningOptions+                            -> LightningT m a+                            -> m (Either (APIError LightningError, Maybe (LightningT m a)) a)+runResumeLightningtWith (LightningOptions cm hu lm s) lightning = do+  manager <- case cm of+    Just m  -> return m+    Nothing -> liftIO $ newManager tlsManagerSettings+  auth <- case lm of+    Anonymous       -> return id+    BasicAuth creds -> return $ uncurry applyBasicAuth creds+  session <- case s of+    Just s' ->+      case snId s' of+        "" -> (fmap . fmap) Just $+          interpretIO (LightningState hu manager Nothing auth) $ createSession $ snName s'+        _ -> return $ Right $ Just s'+    Nothing -> (fmap . fmap) Just $+      interpretIO (LightningState hu manager Nothing auth) $ createSession Nothing+  case session of+    Left (err, _) -> return $ Left (err, Just lightning)+    Right s' ->+      interpretIO (LightningState hu manager s' auth) lightning++-- | Runs the specified route using the current state.+handleReceive :: (MonadIO m, Receivable a) => Route+                    -> LightningState+                    -> m (Either (APIError LightningError) a)+handleReceive r lstate = do+  (res, _, _) <- runAPI (builderFromState lstate) (stConnManager lstate) () $+    API.runRoute r++  return res++-- | Runs the specified route and sends the specified JSON value as the the+-- request body.+handleSendJSON :: (MonadIO m, Receivable a) => Route+                    -> LightningState+                    -> Value+                    -> m (Either (APIError LightningError) a)+handleSendJSON r lstate p = do+  (res, _, _) <- runAPI (builderFromState lstate) (stConnManager lstate) () $+    API.sendRoute p r++  return res++-- | Creates a 'Builder' record to keep track of the lightning-viz server's+-- name and base URL.+builderFromState :: LightningState+                 -> Builder+builderFromState (LightningState hurl _ (Just s) auth) =+  Builder "Lightning" (addSessionId hurl (snId s)) id auth+builderFromState (LightningState hurl _ Nothing auth) =+  Builder "Lightning" hurl id auth++-- | Unwraps the response from interpretIO.+dropResume :: Either (APIError LightningError, Maybe (LightningT m a)) a+                    -> Either (APIError LightningError) a+dropResume (Left (x, _)) = Left x+dropResume (Right x)     = Right x++-- | Stores the current state of the lightning transformer stack.+data LightningState =+  LightningState { stCurrentBaseURL :: T.Text+                   -- ^ Current base URL of the lightning-viz server.+                 , stConnManager    :: Manager+                   -- ^ Current connection manager used to run actions.+                 , stSession        :: Maybe Session+                   -- ^ The current lightning session to run actions against.+                 , stApplyAuth      :: Request -> Request+                   -- ^ Hook to add auth credentials on performing a request+                   -- to the lightning-viz sever.+                 }
+ src/Web/Lightning/Plots.hs view
@@ -0,0 +1,74 @@+{-|+Module      : Web.Lightning.Plots+Description : Lightning Plots+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX+-}++module Web.Lightning.Plots+  (+    -- * Sparse Adjacency Matrix+    AdjacencyPlot(..)+  , adjacencyPlot+    -- * Force-Directed Network+  , ForcePlot(..)+  , forcePlot+    -- * Graph+  , GraphPlot(..)+  , graphPlot+    -- * Graph Bundled+  , graphBundledPlot+    -- * Line+  , LinePlot(..)+  , linePlot+    -- * Map+  , MapPlot(..)+  , mapPlot+    -- * Matrix+  , MatrixPlot(..)+  , matrixPlot+    -- * Scatter+  , ScatterPlot(..)+  , scatterPlot+    -- * 3D Scatter+  , Scatter3Plot(..)+  , scatter3Plot+    -- * Circle+  , CirclePlot(..)+  , circlePlot+    -- * Histogram+  , HistogramPlot(..)+  , histogramPlot+    -- * Volume+  , VolumePlot(..)+  , volumePlot+    -- * Streaming Line Plot+  , LineStreamPlot(..)+  , streamingLinePlot+    -- * Streaming Scatter Plot+  , ScatterStreamPlot(..)+  , streamingScatterPlot++  , module Data.Default.Class+  )+  where++import           Data.Default.Class++import           Web.Lightning.Plots.Adjacency+import           Web.Lightning.Plots.Force+import           Web.Lightning.Plots.Graph+import           Web.Lightning.Plots.GraphBundled+import           Web.Lightning.Plots.Line+import           Web.Lightning.Plots.Map+import           Web.Lightning.Plots.Matrix+import           Web.Lightning.Plots.Circle+import           Web.Lightning.Plots.Histogram+import           Web.Lightning.Plots.Scatter+import           Web.Lightning.Plots.Scatter3+import           Web.Lightning.Plots.LineStream+import           Web.Lightning.Plots.ScatterStream+import           Web.Lightning.Plots.Volume
+ src/Web/Lightning/Plots/Adjacency.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize a sparse adjacency matrix.+module Web.Lightning.Plots.Adjacency+  (+    AdjacencyPlot(..)+  , Visualization (..)+  , adjacencyPlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Adjacency plot parameters+data AdjacencyPlot =+  AdjacencyPlot { apConn      :: [[Double]]+                  -- ^ Matrix that defines the connectivity of the plot. The+                  -- dimensions of the matrix can be (n, n), (n, 2) or (n, 3).+                  -- Matrix can be binary or continuous valued. Links should+                  -- contain either 2 elements per link (source, target) or+                  -- 3 elements (source, target, value).+                , apLabels    :: Maybe [T.Text]+                  -- ^ Text labels for each item (will label rows and columns).+                , apGroup     :: Maybe [Int]+                  -- ^ List to set colors via groups.+                , apSort      :: Maybe T.Text+                  -- ^ What to sort by; options are "group" or "degree."+                , apNumbers   :: Maybe Bool+                  -- ^ Whether or not to show numbers on cells.+                , apSymmetric :: Maybe Bool+                  -- ^ Whether or not to make links symetrical.+                }+  deriving (Show, Eq)++instance Default AdjacencyPlot where+  def = AdjacencyPlot [[]] Nothing Nothing (Just "group") (Just False) (Just True)++instance ToJSON AdjacencyPlot where+  toJSON (AdjacencyPlot conn lbs grps srt nbrs sym) =+    omitNulls [ "links"     .= getLinks conn+              , "nodes"     .= getNodes conn+              , "labels"    .= lbs+              , "group"     .= grps+              , "numbers"   .= nbrs+              , "symmetric" .= sym+              , "srt"       .= srt+              ]++instance ValidatablePlot AdjacencyPlot where+  validatePlot (AdjacencyPlot conn lbls grp srt nbrs sym) = do+    conn' <- validateConn conn+    return $ AdjacencyPlot conn' lbls grp srt nbrs sym++-- | Submits a request to the specified lightning-viz server to create+-- a sparse adjacency matrix visualiazation.+--+-- <http://lightning-viz.org/visualizations/adjacency/ Adjacency Visualization>+adjacencyPlot :: Monad m => AdjacencyPlot+                            -- ^ Adjacency plot to create.+                         -> LightningT m Visualization+                            -- ^ Transformer stack with created visualization.+adjacencyPlot adjPlt = do+  url <- ask+  viz <- sendPlot "adjacency" adjPlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Circle.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize spatial points as a scatter plot.+module Web.Lightning.Plots.Circle+  ( CirclePlot(..)+  , Visualization (..)+  , circlePlot+  ) where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Circle plot parameters+data CirclePlot =+  CirclePlot {+                cpConn   :: [[Double]]+                -- ^ Matrix that defines the connectivity of the plot. The+                -- dimensions of the matrix can be (n, n), (n, 2) or (n, 3).+                -- Matrix can be binary or continuous valued. Links should+                -- contain either 2 elements per link (source, target) or+                -- 3 elements (source, target, value).+              , cpGroup  :: Maybe [Int]+                  -- ^ List to set colors via groups.+              , cpColor  :: Maybe [Int]+                -- ^ (k, 3) : List of rbg values to set colors of top-level+                -- group, where k is the number of unique elements in the+                -- top-level group.+              , cpLabels :: Maybe [T.Text]+                -- ^ List of text labels to label nodes.+              }+  deriving (Show, Eq)++instance Default CirclePlot where+  def = CirclePlot [[]] Nothing Nothing Nothing++instance ToJSON CirclePlot where+  toJSON (CirclePlot conn gs cs ls) =+    omitNulls [ "links"  .= getLinks conn+              , "nodes"  .= getNodes conn+              , "group"  .= gs+              , "color"  .= cs+              , "labels" .= ls+              ]++instance ValidatablePlot CirclePlot where+  validatePlot (CirclePlot conn grp cs lbl) = do+    conn' <- validateConn conn+    cs' <- validateColor cs+    return $ CirclePlot conn' grp cs' lbl++-- | Submits a request to the specified lightning-viz server to create+-- a circular graph from connectivity data.+--+-- <http://lightning-viz.org/visualizations/circle/ Circle Visualization>+circlePlot :: Monad m => CirclePlot+                        -- ^ Circle plot to create.+                      -> LightningT m Visualization+                        -- ^ Transformer stack with created visualization.+circlePlot circlePlt = do+  url <- ask+  viz <- sendPlot "circle" circlePlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Force.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize a force-directed network from connectivity.+module Web.Lightning.Plots.Force+  (+    ForcePlot(..)+  , Visualization (..)+  , forcePlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Force plot parameters+data ForcePlot =+  ForcePlot { fpConn     :: [[Double]]+              -- ^ Matrix that defines the connectivity of the plot. The+              -- dimensions of the matrix can be (n, n), (n, 2) or (n, 3).+              -- Matrix can be binary or continuous valued. Links should+              -- contain either 2 elements per link (source, target) or+              -- 3 elements (source, target, value).+            , fpValues   :: Maybe [Double]+              -- ^ Values to set node colors via a linear scale.+            , fpLabels   :: Maybe [T.Text]+              -- ^ List of text labels to set as tooltips.+            , fpColor    :: Maybe [Int]+              -- ^ Single RGB value or list to set node colors.+            , fpGroup    :: Maybe [Int]+              -- ^ Single integer or list to set node colors via groups.+            , fpColorMap :: Maybe T.Text+              -- ^ Specification of color map, only colorbrewer types supported.+            , fpSize     :: Maybe [Int]+              -- ^ Single size or list to set node sizes.+            , fpToolTips :: Maybe Bool+              -- ^ Whether or not to show tooltips.+            , fpZoom     :: Maybe Bool+              -- ^ Whether or not to allow zooming.+            , fpBrush    :: Maybe Bool+              -- ^ Whether or not to support brushing.+            }+  deriving (Show, Eq)++instance Default ForcePlot where+  def = ForcePlot [[]] Nothing Nothing Nothing Nothing Nothing+          Nothing (Just True) (Just True) (Just True)++instance ToJSON ForcePlot where+  toJSON (ForcePlot conn vs lbs cs gs cm ss tt z b) =+    omitNulls [ "links"     .= getLinks conn+              , "nodes"     .= getNodes conn+              , "values"    .= vs+              , "labels"    .= lbs+              , "color"     .= cs+              , "group"     .= gs+              , "colormap"  .= cm+              , "size"      .= ss+              , "tooltips"  .= tt+              , "zoom"      .= z+              , "brush"     .= b+              ]++instance ValidatablePlot ForcePlot where+  validatePlot (ForcePlot conn vl lbl c grp cm s tt z b) = do+    conn' <- validateConn conn+    c' <- validateColor c+    cm' <- validateColorMap cm+    s' <- validateSize s+    return $ ForcePlot conn' vl lbl c' grp cm' s' tt z b++-- | Submits a request to the specified lightning-viz server to create a+-- force-directed network visualization from connectivity.+--+-- <http://lightning-viz.org/visualizations/force/ Force-Directed Network Visualization>+forcePlot :: Monad m => ForcePlot+                        -- ^ Force plot to create.+                     -> LightningT m Visualization+                        -- ^ Transformer stack with created visualization.+forcePlot forcePlt = do+  url <- ask+  viz <- sendPlot "force" forcePlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Graph.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize graph structure.+module Web.Lightning.Plots.Graph+  (+    GraphPlot(..)+  , Visualization (..)+  , graphPlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Graph plot parameters+data GraphPlot =+  GraphPlot { gpX        :: [Double]+              -- ^ x-points for node co-ordinates.+            , gpY        :: [Double]+              -- ^ y-points for node co-ordinates.+            , gpConn     :: [[Double]]+              -- ^ Matrix that defines the connectivity of the plot. The+              -- dimensions of the matrix can be (n, n), (n, 2) or (n, 3).+              -- Matrix can be binary or continuous valued. Links should+              -- contain either 2 elements per link (source, target) or+              -- 3 elements (source, target, value).+            , gpValues   :: Maybe [Int]+              -- ^ Values to set node colors via a linear scale.+            , gpLabels   :: Maybe [T.Text]+              -- ^ List of text labels to be used as tooltips.+            , gpColors   :: Maybe [Int]+              -- ^ List to set node colors.+            , gpGroup    :: Maybe [Int]+              -- ^ List to set node colors via group assignment.+            , gpColorMap :: Maybe T.Text+              -- ^ Specification of color map; only colorbrewer types supported.+            , gpSize     :: Maybe [Int]+              -- ^ List to set node sizes.+            , gpToolTips :: Maybe Bool+              -- ^ Whether or not to show tooltips.+            , gpZoom     :: Maybe Bool+              -- ^ Whether or not to allow zooming.+            , gpBrush    :: Maybe Bool+              -- ^ Whether or not to support brushing.+            }+  deriving (Show, Eq)++instance Default GraphPlot where+  def = GraphPlot [] [] [[]] Nothing Nothing Nothing Nothing Nothing+          Nothing (Just True) (Just True) (Just True)++instance ToJSON GraphPlot where+  toJSON (GraphPlot xs ys conn vs ls cs gs cm ss t z b) =+    omitNulls [ "links" .= getLinks conn+              , "nodes" .= getPoints xs ys+              , "values" .= vs+              , "labels" .= ls+              , "color"  .= cs+              , "group" .= gs+              , "colormap" .= cm+              , "size"  .= ss+              , "tooltips" .= t+              , "zoom" .= z+              , "brush" .= b+              ]++instance ValidatablePlot GraphPlot where+  validatePlot (GraphPlot xs ys conn vl lbl c g cm s tt z b) = do+    (xs', ys') <- validateCoordinates xs ys+    conn' <- validateConn conn+    c' <- validateColor c+    cm' <- validateColorMap cm+    s' <- validateSize s+    return $ GraphPlot xs' ys' conn' vl lbl c' g cm' s' tt z b++-- | Submits a request to the specified lightning-viz server to create a+-- node-link graph from spatial points and their connectivity.+graphPlot :: Monad m => GraphPlot+                        -- ^ Graph plot to create.+                     -> LightningT m Visualization+                        -- ^ Transformer stack with created visualization.+graphPlot graphPlt = do+  url <- ask+  viz <- sendPlot "graph" graphPlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/GraphBundled.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize a bundled node-link graph.+module Web.Lightning.Plots.GraphBundled+  (+    GraphPlot(..)+  , Visualization(..)+  , graphBundledPlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Plots.Graph         (GraphPlot(..))+import           Web.Lightning.Types.Lightning     (LightningT, sendPlot)+import           Web.Lightning.Types.Visualization (Visualization (..))+--------------------------------------------------------------------------------++-- | Submits a request to the specified lightning-viz server to create a+-- bundled node-link graph visualization.+graphBundledPlot :: Monad m => GraphPlot+                               -- ^ Graph plot to create.+                            -> LightningT m Visualization+                               -- ^ Transformer stack with created visualization.+graphBundledPlot graphPlt = do+  url <- ask+  viz <- sendPlot "graph-bundled" graphPlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Histogram.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize one-dimensional series data as lines.+module Web.Lightning.Plots.Histogram+  (+    HistogramPlot(..)+  , Visualization (..)+  , histogramPlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Histogram plot parameters+data HistogramPlot =+  HistogramPlot { hpValues :: [Double]+                , hpBins   :: Maybe [Double]+                , hpZoom   :: Maybe Bool+                }+  deriving (Show, Eq)++instance Default HistogramPlot where+  def = HistogramPlot [] Nothing (Just True)++instance ToJSON HistogramPlot where+  toJSON (HistogramPlot vs bs z) =+    omitNulls [ "values" .= vs+              , "bins"   .= bs+              , "zoom"   .= z+              ]++instance ValidatablePlot HistogramPlot where+  validatePlot (HistogramPlot v b z) = do+    b' <- validateBin b+    return $ HistogramPlot v b' z++-- | Submits a request to the specified lightning-viz server to create a plot+-- to histogram.+--+-- <http://lightning-viz.org/visualizations/histogram/ HistogramPlot Visualization>+histogramPlot :: Monad m => HistogramPlot+                            -- ^ Histogram plot to create.+                         -> LightningT m Visualization+                            -- ^ Transformer stack with created visualization.+histogramPlot histPlt = do+  url <- ask+  viz <- sendPlot "histogram" histPlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Line.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize one-dimensional series data as lines.+module Web.Lightning.Plots.Line+  (+    LinePlot(..)+  , Visualization (..)+  , linePlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Line plot parameters+data LinePlot =+  LinePlot { lpSeries    :: [[Double]]+             -- ^ Input data for line plot, typically n series of lenght m. Can+             -- also pass a list where each individual series is of different+             -- lengths.+           , lpIndex     :: Maybe [Int]+             -- ^ Specify the index for the x-axis line plot.+           , lpColor     :: Maybe [Int]+             -- ^ Single RGB value or list to set line colors to.+           , lpGroup     :: Maybe [Int]+             -- ^ Single integer or list to set line colors to via group+             -- assignment.+           , lpThickness :: Maybe [Int]+             -- ^ Single integer or list to set line thickness to.+           , lpXaxis     :: Maybe T.Text+             -- ^ Label for x-axis.+           , lpYaxis     :: Maybe T.Text+             -- ^ Label for y-axis.+           , lpZoom      :: Maybe Bool+             -- ^ Whether or not to allow zooming.+           }+  deriving (Show, Eq)++instance Default LinePlot where+  def = LinePlot [[]] Nothing Nothing Nothing Nothing Nothing Nothing (Just True)++instance ToJSON LinePlot where+  toJSON (LinePlot ss is cs gs t xa ya z) =+    omitNulls [ "series"    .= ss+              , "index"     .= is+              , "color"     .= cs+              , "group"     .= gs+              , "thickness" .= t+              , "xaxis"     .= xa+              , "yaxis"     .= ya+              , "zoom"      .= z+              ]++instance ValidatablePlot LinePlot where+  validatePlot (LinePlot s i c g t xa ya z) = do+    i' <- validateIndex i+    c' <- validateColor c+    t' <- validateThickness t+    return $ LinePlot s i' c' g t' xa ya z++-- | Submits a request to the specified lightning-viz server to create a plot+-- to visualize one-dimensional series.+--+-- <http://lightning-viz.org/visualizations/line/ Line Visualization>+linePlot :: Monad m => LinePlot+                       -- ^ Line plot to create.+                    -> LightningT m Visualization+                       -- ^ Transformer stack with created visualization.+linePlot linePlt = do+  url <- ask+  viz <- sendPlot "line" linePlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/LineStream.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize one-dimensional series data as lines.+module Web.Lightning.Plots.LineStream+  (+    LineStreamPlot(..)+  , Visualization (..)+  , streamingLinePlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Streaming line plot parameters+data LineStreamPlot =+  LineStreamPlot { lspSeries        :: [[Double]]+                   -- ^ Input data for line plot, typically n series of lenght m. Can+                   -- also pass a list where each individual series is of different+                   -- lengths.+                 , lspIndex         :: Maybe [Int]+                   -- ^ Specify the index for the x-axis line plot.+                 , lspColor         :: Maybe [Int]+                   -- ^ Single RGB value or list to set line colors to.+                 , lspGroup         :: Maybe [Int]+                   -- ^ Single integer or list to set line colors to via group+                   -- assignment.+                 , lspSize          :: Maybe [Int]+                   -- ^ Sets the line thickness+                 , lspXAxis         :: Maybe T.Text+                   -- ^ Label for the x axis+                 , lspYAxis         :: Maybe T.Text+                   -- ^ Label for the y axis+                 , lspMaxWidth      :: Maybe Int+                   -- ^ The maximum number of time points to show before plot shifts.+                 , lspZoom          :: Maybe Bool+                   -- ^ Whether or not to enable zooming.+                 , lspVisualization :: Maybe Visualization+                 }+  deriving (Show)++instance Default LineStreamPlot where+  def = LineStreamPlot [[]] Nothing Nothing Nothing Nothing+          Nothing Nothing Nothing (Just True) Nothing++instance ToJSON LineStreamPlot where+  toJSON (LineStreamPlot ss is cs gs t xa ya mw z _) =+    omitNulls [ "series"    .= ss+              , "index"     .= is+              , "color"     .= cs+              , "group"     .= gs+              , "size"      .= t+              , "xaxis"     .= xa+              , "yaxis"     .= ya+              , "max_width" .= mw+              , "zoom"      .= z+              ]++instance ValidatablePlot LineStreamPlot where+  validatePlot (LineStreamPlot ss i c g s xa ya mw z viz) = do+    i' <- validateIndex i+    c' <- validateColor c+    s' <- validateSize s+    return $ LineStreamPlot ss i' c' g s' xa ya mw z viz++-- | Plot streaming one-dimensional series data as updating lines.+--+-- <http://lightning-viz.org/visualizations/streaming/ Streaming Line Visualization>+streamingLinePlot :: Monad m => LineStreamPlot+                                -- ^ Line plot to create / update.+                             -> LightningT m Visualization+                                -- ^ Transformer stack with created visualization.+streamingLinePlot slp = do+  url <- ask+  viz <- streamPlot (lspVisualization slp) "line-streaming" slp R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Map.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize a chlorpleth map of the world or united states.+module Web.Lightning.Plots.Map+  (+    MapPlot(..)+  , Visualization (..)+  , mapPlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Map plot parameters+data MapPlot =+  MapPlot { mppRegions  ::  [T.Text]+            -- ^ String identifies for map regions, either length of two+            -- characters (for states in a US map) or length of three+            -- (for counties in a world map).+          , mppWeights  :: [Double]+            -- ^ Values to use to color each reason+          , mppColorMap :: Maybe T.Text+            -- ^ Specification of color map; only colorbrew types supported.+          }+  deriving (Show, Eq)++instance Default MapPlot where+  def = MapPlot [] [] Nothing++instance ToJSON MapPlot where+  toJSON (MapPlot rs vs cm) =+    omitNulls [ "regions"  .= rs+              , "values"   .= vs+              , "colormap" .= cm+              ]++instance ValidatablePlot MapPlot where+  validatePlot (MapPlot r v cm) = do+    r' <- validateRegion r+    cm' <- validateColorMap cm+    return $ MapPlot r' v cm'++-- | Submits a request to the specified lightning-viz server to create a+-- chloropleth map of the world or united states.+--+-- <http://lightning-viz.org/visualizations/map/ Map Visualization>+mapPlot :: Monad m => MapPlot+                      -- ^ Map plot to create.+                   -> LightningT m Visualization+                      -- ^ Transformer stack with created visualization.+mapPlot mapPlt = do+  url <- ask+  viz <- sendPlot "map" mapPlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Matrix.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize a dense matrix or table as a heat map.+module Web.Lightning.Plots.Matrix+  (+    MatrixPlot(..)+  , Visualization (..)+  , matrixPlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Matrix plot parameters+data MatrixPlot =+  MatrixPlot { mpMatrix    :: [[Double]]+               -- ^ Two-dimensional list of matrix data.+             , mpRowLabels :: Maybe [T.Text]+               -- ^ List of strings to label rows.+             , mpColLabels :: Maybe [T.Text]+               -- ^ List of strings to label columns.+             , mpColorMap  :: Maybe T.Text+               -- ^ Specification of color map; only colorbrewer types supported.+             , mpNumbers   :: Maybe Bool+               -- ^ Whether or not to show numbers on the cells.+             }+  deriving (Show, Eq)++instance Default MatrixPlot where+  def = MatrixPlot [[]] Nothing Nothing Nothing (Just False)++instance ToJSON MatrixPlot where+  toJSON (MatrixPlot m rls cls cm nbrs) =+    omitNulls [ "matrix"    .= m+              , "rowLabels" .= rls+              , "colLabels" .= cls+              , "colormap"  .= cm+              , "numbers"   .= nbrs+              ]++instance ValidatablePlot MatrixPlot where+  validatePlot (MatrixPlot mtx rlbl clbl cm nbr) = do+    mtx' <- validateConn mtx+    cm' <- validateColorMap cm+    return $ MatrixPlot mtx' rlbl clbl cm' nbr++-- | Submits a request to the specified lightning-viz server to create a+-- heat map of the given matrix.+--+-- <http://lightning-viz.org/visualizations/matrix/ Matrix Visualization>+matrixPlot :: Monad m => MatrixPlot+                         -- ^ Matrix plot to create.+                      -> LightningT m Visualization+                         -- ^ Transformer stack with created visualization.+matrixPlot matrixPlt = do+  url <- ask+  viz <- sendPlot "matrix" matrixPlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Scatter.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize spatial points as a scatter plot.+module Web.Lightning.Plots.Scatter+  (+    ScatterPlot(..)+  , Visualization (..)+  , scatterPlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Scatter plot parameters+data ScatterPlot =+  ScatterPlot { spX        :: [Double]+                -- ^ List of x points.+              , spY        :: [Double]+                -- ^ List of y points.+              , spValues   :: Maybe [Double]+                -- ^ Values to set node colors via a linear scale.+              , spLabels   :: Maybe [T.Text]+                -- ^ List of text labels to set tooltips.+              , spColor    :: Maybe [Int]+                -- ^ List of rgb values to set colors.+              , spGroup    :: Maybe [Int]+                -- ^ List to set colors via groups.+              , spColorMap :: Maybe T.Text+                -- ^ Specification of color map; only colorbrewer types supported.+              , spSize     :: Maybe [Int]+                -- ^ List to set point sizes.+              , spAlpha    :: Maybe [Double]+                -- ^ List of alpha values to set file and stroke opacity.+              , spXaxis    :: Maybe T.Text+                -- ^ Label for x-axis.+              , spYaxis    :: Maybe T.Text+                -- ^ Label for y-axis.+              , spToolTips :: Maybe Bool+                -- ^ Whether or not to display tooltips.+              , spZoom     :: Maybe Bool+                -- ^ Whether or not to allow zooming.+              , spBrush    :: Maybe Bool+                -- ^ Whether or not to support brushing.+              }+  deriving (Show, Eq)++instance Default ScatterPlot where+  def = ScatterPlot [] [] Nothing Nothing Nothing Nothing Nothing Nothing+          Nothing Nothing Nothing (Just True) (Just True) (Just True)++instance ToJSON ScatterPlot where+  toJSON (ScatterPlot xs ys vs ls cs gs cm ss as xa ya t z b) =+    omitNulls [ "points"    .= getPoints xs ys+              , "values"    .= vs+              , "labels"    .= ls+              , "color"     .= cs+              , "group"     .= gs+              , "colormap"  .= cm+              , "size"      .= ss+              , "alpha"     .= as+              , "xaxis"     .= xa+              , "yaxis"     .= ya+              , "tooltips"  .= t+              , "zoom"      .= z+              , "brush"     .= b+              ]++instance ValidatablePlot ScatterPlot where+  validatePlot (ScatterPlot xs ys v lbl c grp cm s a xa ya tt z b) = do+    (xs', ys') <- validateCoordinates xs ys+    c' <- validateColor c+    cm' <- validateColorMap cm+    s' <- validateSize s+    a' <- validateAlpha a+    return $ ScatterPlot xs' ys' v lbl c' grp cm' s' a' xa ya tt z b++-- | Submits a request to the specified lightning-viz server to create+-- a scatter plot.+--+-- <http://lightning-viz.org/visualizations/adjacency/ Scatter Visualization>+scatterPlot :: Monad m => ScatterPlot+                          -- ^ Scatter plot to create.+                       -> LightningT m Visualization+                          -- ^ Transformer stack with created visualization.+scatterPlot scatterPlt = do+  url <- ask+  viz <- sendPlot "scatter" scatterPlt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Scatter3.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize (x,y,z) co-ordinates as a 3D scatter plot.+module Web.Lightning.Plots.Scatter3+  (+    Scatter3Plot(..)+  , Visualization (..)+  , scatter3Plot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Scatter Plot 3D parameters+data Scatter3Plot =+  Scatter3Plot { sptX      :: [Double]+                 -- ^ List of x points.+               , sptY      :: [Double]+                 -- ^ List of y points.+               , sptZ      :: [Double]+                 -- ^ List of z points.+               , sptColors :: Maybe [Int]+                 -- ^ List of rgb values to set colors.+               , sptGroups :: Maybe [Int]+                 -- ^ List to set colors via groups.+               , sptSize   :: Maybe [Int]+                 -- ^ List to set point sizes.+               , sptAlpha  :: Maybe [Double]+                 -- ^ List of alpha values to set file and stroke opacity.+               }+  deriving (Show, Eq)++instance Default Scatter3Plot where+  def = Scatter3Plot [] [] [] Nothing Nothing Nothing Nothing++instance ToJSON Scatter3Plot where+  toJSON (Scatter3Plot xs ys zs cs gs ss as) =+    omitNulls [ "points"    .= getPoints3 xs ys zs+              , "color"     .= cs+              , "group"     .= gs+              , "size"      .= ss+              , "alpha"     .= as+              ]++instance ValidatablePlot Scatter3Plot where+  validatePlot (Scatter3Plot xs ys zs c g s a) = do+    (xs', ys', zs') <- validateCoordinates3 xs ys zs+    c' <- validateColor c+    s' <- validateSize s+    a' <- validateAlpha a+    return $ Scatter3Plot xs' ys' zs' c' g s' a'++-- | Submits a request to the specified lightning-viz server to create+-- a 3D scatter plot.+--+-- <http://lightning-viz.org/visualizations/scatter-3/ Scatter Visualization>+scatter3Plot :: Monad m => Scatter3Plot+                           -- ^ Scatter plot to create+                        -> LightningT m Visualization+                           -- ^ Transformer stack with created visualization.+scatter3Plot scatter3Plt = do+  url <- ask+  viz <- sendPlot "scatter-3" scatter3Plt R.plot+  return $ viz { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/ScatterStream.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize one-dimensional series data as lines.+module Web.Lightning.Plots.ScatterStream+  (+    ScatterStreamPlot(..)+  , Visualization (..)+  , streamingScatterPlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.Reader++import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Visualization (Visualization (..))+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Scatter plot parameters+data ScatterStreamPlot =+  ScatterStreamPlot { sspX             :: [Double]+                      -- ^ List of x points.+                    , sspY             :: [Double]+                      -- ^ List of y points.+                    , sspValues        :: Maybe [Double]+                      -- ^ Values to set node colors via a linear scale.+                    , sspLabels        :: Maybe [T.Text]+                      -- ^ List of text labels to set tooltips.+                    , sspColor         :: Maybe [Int]+                      -- ^ List of rgb values to set colors.+                    , sspGroup         :: Maybe [Int]+                      -- ^ List to set colors via groups.+                    , sspColorMap      :: Maybe T.Text+                      -- ^ Specification of color map; only colorbrewer types supported.+                    , sspSize          :: Maybe [Int]+                      -- ^ List to set point sizes.+                    , sspXaxis         :: Maybe T.Text+                      -- ^ Label for x-axis.+                    , sspYaxis         :: Maybe T.Text+                      -- ^ Label for y-axis.+                    , sspToolTips      :: Maybe Bool+                      -- ^ Whether or not to display tooltips.+                    , sspZoom          :: Maybe Bool+                      -- ^ Whether or not to allow zooming.+                    , sspBrush         :: Maybe Bool+                      -- ^ Whether or not to support brushing.+                    , sspVisualization :: Maybe Visualization+                      -- ^ The visualization to update. If Nothing, create+                    }+  deriving (Show)++instance Default ScatterStreamPlot where+  def = ScatterStreamPlot [] [] Nothing Nothing Nothing Nothing Nothing+          Nothing Nothing Nothing (Just True) (Just True) (Just True) Nothing+++instance ToJSON ScatterStreamPlot where+  toJSON (ScatterStreamPlot xs ys vs ls cs gs cm ss xa ya t z b _) =+    omitNulls [ "points"    .= getPoints xs ys+              , "values"    .= vs+              , "labels"    .= ls+              , "color"     .= cs+              , "group"     .= gs+              , "colormap"  .= cm+              , "size"      .= ss+              , "xaxis"     .= xa+              , "yaxis"     .= ya+              , "tooltips"  .= t+              , "zoom"      .= z+              , "brush"     .= b+              ]++instance ValidatablePlot ScatterStreamPlot where+  validatePlot (ScatterStreamPlot xs ys v lbl c grp cm s xa ya tt z b viz) = do+    (xs', ys') <- validateCoordinates xs ys+    c' <- validateColor c+    cm' <- validateColorMap cm+    s' <- validateSize s+    return $ ScatterStreamPlot xs' ys' v lbl c' grp cm' s' xa ya tt z b viz++-- | Create a streaming scatter plot of x and y.+--+-- Plotting once returns a visualization on which 'append' can be called to add new data+-- in a streaming fashion. The opacity of old and new data is automatically set+-- to highlight the most recent data and fade old data away.+--+-- <http://lightning-viz.org/visualizations/streaming/ Streaming Scatter Visualization>+streamingScatterPlot :: Monad m => ScatterStreamPlot+                                   -- ^ Scatter plot to create / update.+                                -> LightningT m Visualization+                                   -- ^ Transformer stack with created visualization.+streamingScatterPlot slp = do+  url <- ask+  viz' <- streamPlot (sspVisualization slp) "scatter-streaming" slp R.plot+  return $ viz' { vizBaseUrl = Just url }
+ src/Web/Lightning/Plots/Volume.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Visualize a collection of images as a three-dimensional volume.+module Web.Lightning.Plots.Volume+  (+    VolumePlot(..)+  , Visualization (..)+  , volumePlot+  )+  where++--------------------------------------------------------------------------------+import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text                         as T++import qualified Web.Lightning.Routes              as R+import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types               (Img)+import           Web.Lightning.Types.Visualization (Visualization (..))+--------------------------------------------------------------------------------++-- | Volume plot parameters+data VolumePlot = VolumePlot { vpImages  ::  [Img]+                               -- ^ A collection of images to display. Can be+                               -- 2 dimensional (grey scale) or 3 dimensional+                               -- (RGB) lists.+                             }+                             deriving (Show, Eq)++instance Default VolumePlot where+  def = VolumePlot [ [[[]]] ]++instance ToJSON VolumePlot where+  toJSON (VolumePlot imgs) =+    object [ "images"  .= imgs ]++instance ValidatablePlot VolumePlot where+  validatePlot = return++-- | Submits a request to the specified lightning-viz server to create+-- a visualization of a collection of images as a three-dimensional volume.+--+-- <http://lightning-viz.org/visualizations/volume/ Volume Visualization>+volumePlot :: Monad m => T.Text+                      -- ^ Base URL for lightning-viz server.+                      -> VolumePlot+                      -- ^ Volume plot to create+                      -> LightningT m Visualization+                      -- ^ Transformer stack with created visualization.+volumePlot bUrl volumePlt = do+  viz <- sendPlot "volume" volumePlt R.plot+  return $ viz { vizBaseUrl = Just bUrl }
+ src/Web/Lightning/Render.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Contains functions needed for rendering plots in IHaskell.+module Web.Lightning.Render+  (+    -- * IHaskell Rendering+    renderPlot+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.IO.Class++import qualified Data.ByteString.Lazy              as BS+import qualified Data.Text                         as T+import           Data.Text.Encoding                (decodeUtf8)++import           Network.API.Builder.Error+import           Network.HTTP.Client+import           Network.HTTP.Client.TLS++import qualified Text.Blaze.Html                   as BZ++import           Web.Lightning.Types.Visualization (Visualization (..),+                                                    getPublicLink)+--------------------------------------------------------------------------------++-- | For use in IHaskell - Renders the visualization in an IHaskell notebook.+renderPlot :: Either (APIError a) Visualization+              -- ^ The visualization to render.+           -> IO BZ.Markup+              -- ^ The HTML representation of the visualization.+renderPlot (Left _) = return $ BZ.string "No visualization."+renderPlot (Right viz) = do+  manager <- liftIO $ newManager tlsManagerSettings+  req <- parseRequest $ T.unpack $ getPublicLink viz+  vizHtml <- httpLbs req manager++  return $ BZ.preEscapedToMarkup $+    decodeUtf8 $ BS.toStrict $ responseBody vizHtml
+ src/Web/Lightning/Routes.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Web.Lightning.Routes+Description : Defines route mappings to lightning-viz API endpoints.+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX++Defines the Route mappings to the lightning-viz API.+-}++module Web.Lightning.Routes+  ( -- * API Endpoints+    plot+  , stream+  , publicLink+  )+  where++--------------------------------------------------------------------------------+import           Network.API.Builder               hiding (runRoute)++import           Web.Lightning.Types.Visualization (Visualization (..))+--------------------------------------------------------------------------------++-- | The main route that corresponds to the /visualizations endpoint. Using+-- this route, one can create and update plots.+plot :: Route+        -- ^ Returns a new route corresponding to /sessionId/visualizations.+plot = Route ["visualizations"]+             []+             "POST"++-- | This route is used in conjunction with streaming plot functions.+stream :: Visualization+          -- ^ Visualization to append+       -> Route+          -- ^ Returns the URL to update the visualization.+stream (Visualization i _ _) =+  Route ["visualizations", i, "data"]+        []+        "POST"++-- | Corresponds to the public URL of a visualization.+publicLink :: Visualization+              -- ^ The visualization to create the public link for.+           -> Route+              -- ^ Route representing public link for visualization.+publicLink (Visualization i _ _) =+  Route ["visualizations", i, "public"]+        []+        "GET"
+ src/Web/Lightning/Session.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Web.Lightning.Session+Description : Session management.+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX++Defines interactions with the session endpoint.+-}++module Web.Lightning.Session+  (+    -- * Session Functions+    createSession+  , module Web.Lightning.Types.Session+  ) where++--------------------------------------------------------------------------------+import           Data.Maybe+import qualified Data.Text                     as T++import           Network.API.Builder           hiding (runRoute)++import           Web.Lightning.Types.Lightning+import           Web.Lightning.Types.Session+--------------------------------------------------------------------------------++-- | Session endpoint.+createSessionRoute :: Maybe T.Text+                      -- ^ An optional name for the session+                   -> Route+                      -- ^ The lightning-viz session endpoint+createSessionRoute n = Route ["sessions"]+                             ["name" =. fromMaybe "" n]+                             "POST"++-- | Creates a new session with an optional name.+createSession :: Monad m => Maybe T.Text+                            -- ^ An optional session name+                         -> LightningT m Session+                            -- ^ Returns the LightningT transformer stack+createSession n = receiveRoute $ createSessionRoute n
+ src/Web/Lightning/Types.hs view
@@ -0,0 +1,37 @@+{-|+Module      : Web.Lightning.Types+Description : Re-exports main types.+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX++Re-exports all the main types one is likely to need.+-}++module Web.Lightning.Types+  (+    -- * Lightning Types+    LightningError(..)+  , Session(..)+  , Visualization(..)+  , Pixel+  , Img+  )+  where++--------------------------------------------------------------------------------+import           Data.Word++import           Web.Lightning.Types.Error         (LightningError (..))+import           Web.Lightning.Types.Session       (Session (..))+import           Web.Lightning.Types.Visualization (Visualization (..))+--------------------------------------------------------------------------------++-- | Can represent an RGBA [red, green, blue, alpha],+-- RGB [red, green, blue], and GreyScale [intensity] pixel.+type Pixel = [Word8]++-- | Represents an image as a matrix of pixels.+type Img = [[Pixel]]
+ src/Web/Lightning/Types/Error.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Web.Lightning.Types.Error+Description : Lightning error type+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX+-}++module Web.Lightning.Types.Error+  (+    -- Error Types+    LightningError(..)+  ) where++--------------------------------------------------------------------------------+import           Data.Aeson+import qualified Data.Text                   as T++import           Network.API.Builder.Receive+--------------------------------------------------------------------------------++-- | Represents the different errors that may be raised in the lightning-viz+-- wrapper.+data LightningError = LightningError  Object+                      -- ^ Represents a JSON error returned by lightning-viz.+                    | FailError       T.Text+                      -- ^ Represents a generic exception error.+                    | ValidationError T.Text+                      -- ^ Represents a validation error in a request record.+                    deriving (Show, Eq)++instance FromJSON LightningError where+  parseJSON (Object o) = return $ LightningError o+  parseJSON _          = mempty++instance ErrorReceivable LightningError where+  receiveError = useErrorFromJSON
+ src/Web/Lightning/Types/Lightning.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}++{-|+Module      : Web.Lightning.Types.Lightning+Description : Main Lightning Types+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX+-}++module Web.Lightning.Types.Lightning+  (+    -- * Lightning Types+    Lightning+  , LightningF(..)+  , LightningT(..)+  , ValidatablePlot(..)+    -- * Lightning Actions+  , runRoute+  , sendPlot+  , streamPlot+  , sendJSON+  , receiveRoute+  , withBaseURL+  , failWith+  , liftLightningF+  )+  where++--------------------------------------------------------------------------------+import           Control.Monad.IO.Class+import           Control.Monad.Reader+import           Control.Monad.Trans.Free++import           Data.Aeson+import qualified Data.Text                         as T++import           Network.API.Builder               hiding (runRoute)++import           Web.Lightning.Routes              (stream)+import           Web.Lightning.Types.Error+import           Web.Lightning.Types.Visualization+import           Web.Lightning.Utilities+--------------------------------------------------------------------------------++-- | Allows plot fields to be validated.+class ValidatablePlot a where+  validatePlot :: a -> Either LightningError a++-- | Represents an IO Lightning transformer action.+type Lightning a = LightningT IO a++-- | Represents a URL.+type BaseUrl = T.Text++-- | Defines the available actions+data LightningF m a where+  FailWith     :: APIError LightningError -> LightningF m a+  ReceiveRoute :: Receivable b => Route -> (b -> a) -> LightningF m a+  RunRoute     :: FromJSON b => Route -> (b -> a) -> LightningF m a+  SendJSON     :: (Receivable b) => Value -> Route -> (b -> a) -> LightningF m a+  WithBaseURL  :: T.Text -> LightningT m b -> (b -> a) -> LightningF m a++instance Functor (LightningF m) where+  fmap _ (FailWith x)        = FailWith x+  fmap f (ReceiveRoute r x)  = ReceiveRoute r (fmap f x)+  fmap f (RunRoute r x)      = RunRoute r (fmap f x)+  fmap f (SendJSON js r x)   = SendJSON js r (fmap f x)+  fmap f (WithBaseURL u a x) = WithBaseURL u a (fmap f x)++-- | Defines free monad transformer+newtype LightningT m a = LightningT (ReaderT BaseUrl (FreeT (LightningF m) m) a)+  deriving (Functor, Applicative, Monad, MonadReader T.Text)++instance MonadIO m => MonadIO (LightningT m) where+  liftIO = LightningT . liftIO++instance MonadTrans LightningT where+  lift = LightningT . lift . lift++-- | Lifts a 'LightningF' free monad into the ReaderT context.+liftLightningF :: (Monad m) => FreeT (LightningF m) m a+               -> ReaderT T.Text (FreeT (LightningF m) m) a+liftLightningF = lift++-- | Runs a route action within the free monadic transformer context.+runRoute :: (FromJSON a, Monad m) => Route+                                     -- ^ Route to run+                                  -> LightningT m a+                                     -- ^ Monad transformer stack with result.+runRoute r = LightningT $ liftF $ RunRoute r id++-- | Sends a request to the lightning-viz server to create a visualization.+sendPlot :: (ToJSON p, ValidatablePlot p, Receivable a, Monad m) => T.Text+                                                 -- ^ The plot type+                                              -> p+                                                 -- ^ The plot creation request+                                              -> Route+                                                 -- ^ The plot route.+                                              -> LightningT m a+                                                 -- ^ Monad transformer stack with result.+sendPlot t p r =+  case validatePlot p of+    Left err -> failWith (APIError err)+    Right p' -> sendJSON (createPayLoad t $ toJSON p') r++-- | Sends a request to either create a brand new streaming plot or+-- to append data to an existing streaming plot.+streamPlot :: (ToJSON p,+               ValidatablePlot p,+               Receivable a,+               Monad m) => Maybe Visualization+                           -- ^ Visualization to update. If nothing, create+                           -- a new plot.+                        -> T.Text+                           -- ^ Plot type+                        -> p+                           -- ^ Plot payload+                        -> Route+                           -- ^ Route to send plot to.+                        -> LightningT m a+                           -- ^ Monad transformer stack with result.+streamPlot viz t p r =+  case validatePlot p of+    Left err -> failWith (APIError err)+    Right _  -> streamOrCreate viz+  where+    streamOrCreate (Just viz') = sendJSON (createDataPayLoad $ toJSON p) (stream viz')+    streamOrCreate Nothing = sendJSON (createPayLoad t $ toJSON p) r++-- | Sends a request containing JSON to the specified route.+sendJSON :: (Receivable a, Monad m) => Value+                                       -- ^ The JSON payload+                                    -> Route+                                       -- ^ Route to send request to+                                    -> LightningT m a+                                       -- ^ Monad transformer stack with result.+sendJSON j r = LightningT $ liftF $ SendJSON j r id++-- | Send and receives a GET request to the specified route.+receiveRoute :: (Receivable a, Monad m) => Route+                                           -- ^ The route to retrieve data from.+                                        -> LightningT m a+                                           -- ^ Monad transformer stack with result.+receiveRoute r = LightningT $ liftF $ ReceiveRoute r id++-- | Replaces the base URL in the stack and run the supplied action afterwards.+withBaseURL :: Monad m => T.Text+                          -- ^ The new base URL.+                       -> LightningT m a+                          -- ^ Next action to run.+                       -> LightningT m a+                          -- ^ Monad transformer stack with result.+withBaseURL u f = LightningT $ liftF $ WithBaseURL u f id++-- | Returns an error message.+failWith :: Monad m => APIError LightningError+                       -- ^ The error message to return.+                    -> LightningT m a+                       -- ^ Monad transformer stack with error.+failWith = LightningT . liftF . FailWith
+ src/Web/Lightning/Types/Session.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Web.Lightning.Types.Session+Description : Session management types.+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX++Defines the types needed for interaction with the session endpoint.+-}++module Web.Lightning.Types.Session+  (+    -- * Session Types+    Session(..)+  )+  where++--------------------------------------------------------------------------------+import           Data.Aeson+import           Data.Default.Class+import qualified Data.Text           as T++import           Network.API.Builder hiding (runRoute)+--------------------------------------------------------------------------------++-- | Represents a lightning-viz session. A session ID is required to create+-- a plot.+data Session =+  Session { snId   :: T.Text+            -- ^ The unique session ID+          , snName :: Maybe T.Text+            -- ^ The optional session name+          , snUpdated   :: Maybe T.Text+            -- ^ The timestamp of when the session was last updated+          , snCreated   :: Maybe T.Text+            -- ^ Creation timestamp+          }+  deriving (Show, Read, Eq)++instance FromJSON Session where+  parseJSON (Object v) =+    Session <$>+    v .: "id" <*>+    v .: "name" <*>+    v .: "updatedAt" <*>+    v .: "createdAt"+  parseJSON _ = mempty++instance Receivable Session where+  receive = useFromJSON++instance Default Session where+  def = Session "" Nothing Nothing Nothing
+ src/Web/Lightning/Types/Visualization.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Web.Lightning.Types.Visualization+Description : Visualization type+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX++Describes the primary visualization return type along+with some helper functions.+-}++module Web.Lightning.Types.Visualization+  (+    -- * Visualization Types+    Visualization(..)+    -- * Visualization Helper Functions+  , getEmbedLink+  , getIFrameLink+  , getPymLink+  , getPublicLink+  )+  where++--------------------------------------------------------------------------------+import           Data.Aeson+import qualified Data.Text                     as T++import           Network.API.Builder           hiding (runRoute)++import           Web.Lightning.Utilities       (defaultBaseURL)+--------------------------------------------------------------------------------++-- | Encapsulates the basic information about a created+-- visualization.+data Visualization =+  Visualization { vizId        :: T.Text+                  -- ^ The unique identifier for a visualization+                , vizSessionID :: T.Text+                  -- ^ The session ID the visualization was created in+                , vizBaseUrl   :: Maybe T.Text+                  -- ^ Base URL gets filled in later+                } deriving (Show)++instance FromJSON Visualization where+  parseJSON (Object o) =+    Visualization <$> o .: "id"+                  <*> o .: "SessionId"+                  <*> o .:? "url"+  parseJSON _ = mempty++instance Receivable Visualization where+  receive = useFromJSON++-- | Appends a '/' to a URL if it is not there already.+formatURL :: T.Text+             -- ^ Base URL+          -> T.Text+             -- ^ Returns the formatted URL+formatURL url =+  case T.last url of+    '/' -> url+    _   -> T.concat [url, "/"]++-- | Returns the permanent link for a visualization.+getPermaLinkURL :: Visualization+                   -- ^ The visualization to get permalink for+                -> T.Text+                   -- ^ Returns the permalink for visualization.+getPermaLinkURL (Visualization i _ (Just bUrl)) =+  T.concat [formatURL bUrl, "visualizations/", i]+getPermaLinkURL (Visualization i _ Nothing) =+  T.concat [formatURL defaultBaseURL, "visualizations/", i]++-- | Returns a partial URL based on the link type parameter.+getLinkType :: Visualization+               -- ^ Visualization to create link for+            -> T.Text+               -- ^ The link type+            -> T.Text+               -- ^ The partially formatted URL+getLinkType viz link = formatURL $ T.concat [permaLink, link]+  where permaLink = getPermaLinkURL viz++-- | Returns the embedded link URL for a visualization.+getEmbedLink :: Visualization+                -- ^ Visualization to create embedded link+             -> T.Text+                -- ^ Returns the embedded link for visualization+getEmbedLink viz = getLinkType viz "/embed/"++-- | Returns the iFrame link URL for a visualization+getIFrameLink :: Visualization+                 -- ^ Visualization to create iFrame link for+              -> T.Text+                 -- ^ Returns the iFrame link for visualization+getIFrameLink viz = getLinkType viz "/iframe/"++-- | Returns the PYM link for visualization.+getPymLink :: Visualization+              -- ^ Visualization to create PYM link for+           -> T.Text+              -- ^ Returns the PYM link for visualization+getPymLink viz = getLinkType viz "/pym/"++-- | Returns the public link for a visualization.+getPublicLink :: Visualization+                 -- ^ Visualization to create public link for.+              -> T.Text+                 -- ^ Returns the public link for visualization.+getPublicLink viz = getLinkType viz "/public/"
+ src/Web/Lightning/Utilities.hs view
@@ -0,0 +1,263 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Web.Lightning.Utilities+Description : Commonly used utility functions.+Copyright   : (c) Connor Moreside, 2016+License     : BSD-3+Maintainer  : connor@moresi.de+Stability   : experimental+Portability : POSIX++Contains commonly used utility functions used throughout the library.+-}++module Web.Lightning.Utilities+  (+    -- * Utility Functions+    omitNulls+  , createPayLoad+  , createDataPayLoad+  , addSessionId+  , getLinks+  , getNodes+  , getPoints+  , getPoints3+    -- * Validation Functions+  , validateBin+  , validateColor+  , validateColorMap+  , validateSize+  , validateAlpha+  , validateThickness+  , validateIndex+  , validateCoordinates+  , validateCoordinates3+  , validateRegion+  , validateConn+  , defaultBaseURL+  )+  where++--------------------------------------------------------------------------------+import           Data.Aeson+import qualified Data.Text                 as T++import           Web.Lightning.Types.Error+--------------------------------------------------------------------------------++-- | Used in conjunction with ToJSON. It will stop any field that is+-- Nothing (null) in a record from being encoded in JSON.+omitNulls :: [(T.Text, Value)]+             -- ^ The plot object to be serialized into JSON Value+          -> Value+             -- ^ The plot object with Nothing (null) fields removed.+omitNulls = object . filter notNull where+  notNull (_, Null) = False+  notNull _         = True++-- | Converts the plot creation request record into the proper+-- JSON object that the lightning-viz server expects.+createPayLoad :: T.Text+                 -- ^ The name of the type of plot to create+              -> Value+                 -- ^ The plot creation request record in JSON Value format+              -> Value+                 -- ^ The properly encoded payload object+createPayLoad t p = object [("type", toJSON t), ("data", p)]++-- | Creates a payload for streaming plots.+createDataPayLoad :: Value+                     -- ^ Data to update.+                  -> Value+                     -- ^ The properly encoded payload object.+createDataPayLoad p = object [("data", p)]++-- | Appends the session route and session id to current URL.+addSessionId :: T.Text+                -- ^ The current URL+             -> T.Text+                -- ^ The session ID to add to current URL+             -> T.Text+                -- ^ Returns the URL with the session ID+addSessionId url sId = url `T.append` "/sessions/"  `T.append` sId++-- | Retrieves all the links for each of the nodes in the adjacency+-- matrix.+getLinks :: [[Double]]+            -- ^ The adjacency matrix+         -> [[Double]]+            -- ^ All the links for each of the nodes+getLinks conn+  | length conn == length (head conn) = s1 (zipWithIndex conn)+  | otherwise                         = s4 conn+  where s1 = concatMap (\(row, i) -> s3 i (s2 (zipWithIndex row)))+        s2 = filter (\(x, _) -> x /= 0)+        s3 i = map (\(x, j) -> [i, j, x] :: [Double])+        s4 xs = case length xs of+          2 -> xs+          3 -> map (\l -> [head l, l !! 1, 1.0]) xs+          _ -> [[]]++zipWithIndex :: (Enum b, Num b) => [a] -> [(a, b)]+zipWithIndex [] = []+zipWithIndex xs = zipWith (\i el -> (i, el)) xs [0..]++-- | Retrieves all of the nodes from an adjacency matrix.+getNodes :: [[Double]]+            -- ^ The adjacency matrix+         -> [Int]+            -- ^ A list of all of the nodes in matrix+getNodes conn+  | length conn == length (head conn) = [0..length conn - 1]+  | otherwise                         = [0..n - 1]+  where n = floor $ maximum $ map maximum conn+++-- | Zips up x and y points into array pairs.+getPoints :: [Double]+             -- ^ X points+          -> [Double]+             -- ^ Y points+          -> [[Double]]+             -- ^ Returns [ [x, y] ] pairs+getPoints xs ys = map (\(x, y) -> [x, y]) $ zip xs ys++-- | Zips up x, y, and z points into array triples.+getPoints3 :: [Double]+              -- ^ X points+           -> [Double]+              -- ^ Y points+           -> [Double]+              -- ^ Z points+           -> [[Double]]+              -- ^ Returns [ [x, y, z] ] triplets+getPoints3 xs ys zs = map (\(x, y, z) -> [x, y, z]) $ zip3 xs ys zs++-- | Validates the bins of a histogram+validateBin :: Maybe [Double]+             -> Either LightningError (Maybe [Double])+validateBin = return++-- | Verify that the color specs are either in the form of+-- [r, g, b] or a list of [[r,g,b],[r,g,b],...]+validateColor :: Maybe [Int]+               -> Either LightningError (Maybe [Int])+validateColor (Just colors)+  | length colors == 3 = Right (Just colors)+  | otherwise          = Left $ ValidationError "Color must have three values."+validateColor Nothing = Right Nothing++-- | Verifiy that the color map specified is on of the colorbrewer maps.+--+-- Here are the available colorbrewer values:+-- "BrBG", "PiYG", "PRGn", "PuOr", "RdBu", "RdGy", "RdYlBu",+-- "RdYlGn", "Spectral", "Blues", "BuGn", "BuPu", "GnBu",+-- "Greens", "Greys", "Oranges", "OrRd", "PuBu", "PuBuGn",+-- "PuRd", "Purples", "RdPu", "Reds", "YlGn", "YlGnBu",+-- "YlOrBr", "YlOrRd", "Accent", "Dark2", "Paired", "Pastel1",+-- "Pastel2", "Set1", "Set2", "Set3", or "Lightning"+validateColorMap :: Maybe T.Text+                 -> Either LightningError (Maybe T.Text)+validateColorMap cm@(Just cmv) =+  if cmv `elem` colorMaps+    then Right cm+    else Left $ ValidationError "Invalid color map specified."+  where colorMaps = ["BrBG", "PiYG", "PRGn", "PuOr", "RdBu", "RdGy", "RdYlBu",+                     "RdYlGn", "Spectral", "Blues", "BuGn", "BuPu", "GnBu",+                     "Greens", "Greys", "Oranges", "OrRd", "PuBu", "PuBuGn",+                     "PuRd", "Purples", "RdPu", "Reds", "YlGn", "YlGnBu",+                     "YlOrBr", "YlOrRd", "Accent", "Dark2", "Paired", "Pastel1",+                     "Pastel2", "Set1", "Set2", "Set3", "Lightning"]+validateColorMap Nothing = Right Nothing++-- | Verify that all size values are greater than zero.+validateSize :: Maybe [Int]+             -> Either LightningError (Maybe [Int])+validateSize size = validateGreaterThan0 size msg+  where msg = "Sizes cannot be 0 or negative."++-- | Verify all alpha values are greater than 0+validateAlpha :: Maybe [Double]+              -> Either LightningError (Maybe [Double])+validateAlpha alpha = validateGreaterThan0 alpha msg+  where msg = "Alpha cannot be 0 or negative."++-- | Verify all thickness values are greater than 0.+validateThickness :: Maybe [Int]+                  -> Either LightningError (Maybe [Int])+validateThickness thickness = validateGreaterThan0 thickness msg+  where msg = "Thickness cannot be 0 or negative."++-- | Verify that there is at least one element in list.+validateIndex :: Maybe [Int]+              -> Either LightningError (Maybe [Int])+validateIndex index@(Just idx)+  | not (null idx) = Right index+  | otherwise      = Left $ ValidationError "Index must be non-singleton."+validateIndex Nothing = Right Nothing++-- | Verify that the length of vector x is equal to length of vector y.+validateCoordinates :: [Double]+                        -- ^ x vector+                    -> [Double]+                        -- ^ y vector+                    -> Either LightningError ([Double], [Double])+validateCoordinates xs ys =+  if length xs == length ys+    then Right (xs, ys)+    else Left $ ValidationError "x and y vectors must be the same length."++-- | Verify that the lenths of the x, y, and z vectors are the same length.+validateCoordinates3 :: [Double]+                        -- ^ x vector+                     -> [Double]+                        -- ^ y vector+                     -> [Double]+                        -- ^ z vector+                     -> Either LightningError ([Double],[Double],[Double])+validateCoordinates3 xs ys zs =+  if (length xs == length ys) && (length ys == length zs)+    then Right (xs, ys, zs)+    else Left $ ValidationError "x, y, and z vectors must be the same length."++-- | Verify that the lengths of the region names are either 2 letters or 3+-- letters.+--+-- 2 letter region names must correspond to US states and 3 letter+-- region names must correspond to countries of the world.+validateRegion :: [T.Text]+               -> Either LightningError [T.Text]+validateRegion regions =+  if checkTwo || checkThree+    then Right regions+    else Left $ ValidationError msg+  where+    msg = "All region names must be all 2 letters or all 3 letters."+    checkTwo = all (\x -> T.length x == 2) regions+    checkThree = all (\x -> T.length x == 3) regions++-- | Verify that the multi-dimensional list adheres to expected dimensions.+validateConn :: [[Double]]+             -> Either LightningError [[Double]]+validateConn conn+  | length conn == length (head conn) = Right conn+  | length (head conn) == 2           = Right conn+  | length (head conn) == 3           = Right conn+  | otherwise                         = Left $ ValidationError msg+  where+    msg = "Too many entries per link, must be 2 or 3."++-- | Ensure all values are greater than 0.+validateGreaterThan0 :: (Ord a, Num a) => Maybe [a]+                                         -> T.Text+                                         -> Either LightningError (Maybe [a])+validateGreaterThan0 vals@(Just vs) msg =+  if any (<= 0) vs+    then Left $ ValidationError msg+    else Right vals+validateGreaterThan0 Nothing _ = Right Nothing++-- | Defines the default URL for the lightning-viz server.+defaultBaseURL :: T.Text+defaultBaseURL = "http://localhost:3000"
+ test-integration/ConfigLightning.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++module ConfigLightning where++import qualified Data.Text as T++import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Network.API.Builder++import System.Environment+import System.Exit++import Web.Lightning.Session+import Web.Lightning++isRight :: Either a b -> Bool+isRight = const False `either` const True++isLeft :: Either a b -> Bool+isLeft = const True `either` const False++newtype RunLightning = RunLightning+  { run :: forall a. Lightning a -> IO (Either (APIError LightningError) a) }++configLightning :: IO RunLightning+configLightning = do+  url <- getEnv "LIGHTNING_VIZ_URL"+  manager <- newManager tlsManagerSettings+  session <- interpretIO (LightningState (T.pack url) manager Nothing id) $ createSession (Just "Integration Tests")+  case session of+    Left  _ -> exitFailure+    Right s ->+      return $ RunLightning $ runLightningWith (LightningOptions (Just manager) (T.pack url) Anonymous (Just s))
+ test-integration/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test-integration/Web/Lightning/PlotSpec.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.Lightning.PlotSpec where++import           ConfigLightning++import           Control.Monad.IO.Class++import           Test.Hspec++import           Data.Maybe+import qualified Data.Text as T++import           System.Environment++import           Web.Lightning+import           Web.Lightning.Plots+import           Web.Lightning.Session++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  lightning <- runIO configLightning+  urlStr <- runIO $ getEnv "LIGHTNING_VIZ_URL"++  let url = T.pack urlStr++  describe "Lightning Integration Tests" $ do+    it "create Adjacency plot." $ do+      res <- run lightning $ adjacencyPlot def { apConn = [[1,2,3],[4,5,6],[7,8,9]] }+      res `shouldSatisfy` isRight+    it "create Circle plot." $ do+      res <- run lightning $ circlePlot def { cpConn = [[1,2,3],[4,5,6],[7,8,9]] }+      res `shouldSatisfy` isRight+    it "create Force plot." $ do+      res <- run lightning $ forcePlot def { fpConn = [[1,2,3],[4,5,6],[7,8,9]] }+      res `shouldSatisfy` isRight+    it "create Graph plot." $ do+      res <- run lightning $ graphPlot def { gpX = [1,2,3], gpY = [1,2,3], gpConn = [[1,2,3],[4,5,6],[7,8,9]] }+      res `shouldSatisfy` isRight+    it "create GraphBundled plot." $ do+      res <- run lightning $ graphPlot def { gpX = [1,2,3], gpY = [1,2,3], gpConn = [[1,2,3],[4,5,6],[7,8,9]] }+      res `shouldSatisfy` isRight+    it "create Histogram plot." $ do+      res <- run lightning $ histogramPlot def { hpValues = [1,2,2,3,3,3,4,4,5] }+      res `shouldSatisfy` isRight+    it "create Line plot." $ do+      res <- run lightning $ linePlot def { lpSeries = [[1,2,3]] }+      res `shouldSatisfy` isRight+    it "create Map plot." $ do+      res <- run lightning $ mapPlot def { mppRegions = ["CAN","USA","MEX"], mppWeights = [13.0,10.0,4.0] }+      res `shouldSatisfy` isRight+    it "create Matrix plot." $ do+      res <- run lightning $ matrixPlot def { mpMatrix = [[1,1,0],[2,0,0],[3,0,0]] }+      res `shouldSatisfy` isRight+    it "create Scatter plot." $ do+      res <- run lightning $ scatterPlot def { spX = [1,2,3], spY = [1,1,1] }+      res `shouldSatisfy` isRight+    it "create 3D Scatter plot." $ do+      res <- run lightning $ scatter3Plot def { sptX = [1,2,3], sptY = [1,1,1], sptZ = [0,0,0] }+      res `shouldSatisfy` isRight+    it "create Streaming line plot." $ do+      res <- run lightning $ streamingLinePlot def { lspSeries = [[1,2,3]] }+      res `shouldSatisfy` isRight+    it "create Streaming scatter plot." $ do+      res <- run lightning $ streamingScatterPlot def { sspX = [1,2,3], sspY = [1,2,3] }+      res `shouldSatisfy` isRight
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/Web/Lightning/Types/PlotsSpec.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.Lightning.Types.PlotsSpec where++import           Test.Hspec++import           Data.Aeson+import           Data.Maybe++import           Web.Lightning.Plots+import           Web.Lightning.Types.Lightning (validatePlot)++isRight :: Either a b -> Bool+isRight = const False `either` const True++isLeft :: Either a b -> Bool+isLeft = const True `either` const False++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "Lightning Plot Serialization" $ do+    it "encodes default LinePlot property names" $ do+      let testInput = def { lpSeries = [[1,2,3]] } :: LinePlot+        in encode testInput `shouldBe` "{\"series\":[[1,2,3]],\"zoom\":true}"+    it "encodes default HistogramPlot property names" $ do+      let testInput = def { hpValues = [1,1,2,2,2,3,3,3], hpZoom = Just False } :: HistogramPlot+        in encode testInput `shouldBe` "{\"values\":[1,1,2,2,2,3,3,3],\"zoom\":false}"+    it "encodes default ScatterPlot property names" $ do+      let testInput = def { spX = [1,2,3], spY = [4,5,6] } :: ScatterPlot+        in encode testInput `shouldBe` "{\"points\":[[1,4],[2,5],[3,6]],\"tooltips\":true,\"zoom\":true,\"brush\":true}"+    it "encodes default MatrixPlot property names" $ do+      let testInput = def { mpMatrix = [[1,2,3],[4,5,6],[7,8,9]] } :: MatrixPlot+        in encode testInput `shouldBe` "{\"matrix\":[[1,2,3],[4,5,6],[7,8,9]],\"numbers\":false}"+    it "encodes default Scatter3Plot property names" $ do+      let testInput = def { sptX = [1,2,3], sptY = [4,5,6], sptZ = [7,8,9] } :: Scatter3Plot+        in encode testInput `shouldBe` "{\"points\":[[1,4,7],[2,5,8],[3,6,9]]}"+    it "encodes default MapPlot property names" $ do+      let testInput = def { mppRegions = ["CAN", "USA"], mppWeights = [0.8, 1.0] } :: MapPlot+        in encode testInput `shouldBe` "{\"values\":[0.8,1],\"regions\":[\"CAN\",\"USA\"]}"+    it "encodes default AdjacencyPlot property names" $ do+      let testInput = def { apConn = [[1,2],[3,4]] } :: AdjacencyPlot+        in encode testInput `shouldBe` "{\"symmetric\":true,\"srt\":\"group\",\"numbers\":false,\"links\":[[0,0,1],[0,1,2],[1,0,3],[1,1,4]],\"nodes\":[0,1]}"+    it "encodes default CirclePlot property names" $ do+      let testInput = def { cpConn = [[1,2],[3,4]], cpGroup = Just [1, 1] } :: CirclePlot+        in encode testInput `shouldBe` "{\"group\":[1,1],\"links\":[[0,0,1],[0,1,2],[1,0,3],[1,1,4]],\"nodes\":[0,1]}"+    it "encodes default ForcePlot property names" $ do+      let testInput = def { fpConn = [[1,2,3],[4,5,6],[7,8,9]] } :: ForcePlot+        in encode testInput `shouldBe` "{\"tooltips\":true,\"zoom\":true,\"links\":[[0,0,1],[0,1,2],[0,2,3],[1,0,4],[1,1,5],[1,2,6],[2,0,7],[2,1,8],[2,2,9]],\"nodes\":[0,1,2],\"brush\":true}"+    it "encodes default GraphPlot property names" $ do+      let testInput = def { gpX = [1,2,3], gpY = [4,5,6], gpConn = [[1,2,3],[4,5,6],[7,8,9]] } :: GraphPlot+        in encode testInput `shouldBe` "{\"tooltips\":true,\"zoom\":true,\"links\":[[0,0,1],[0,1,2],[0,2,3],[1,0,4],[1,1,5],[1,2,6],[2,0,7],[2,1,8],[2,2,9]],\"nodes\":[[1,4],[2,5],[3,6]],\"brush\":true}"++  describe "Lighting Plot Validation" $ do+    it "should be IsRight for valid AdjacencyPlot." $ do+      let testInput = validatePlot $ def { apConn = [[1,2,3],[4,5,6],[7,8,9]] }+        in testInput `shouldSatisfy` isRight+    it "should be IsLeft for invalid AdjacencyPlot." $ do+      let testInput = validatePlot $ def { apConn = [[], [1,2,3,4]] }+        in testInput `shouldSatisfy` isLeft+    it "should be IsRight for valid CirclePlot." $ do+      let testInput = validatePlot $ def { apConn = [[1,2],[3,4]] }+        in testInput `shouldSatisfy` isRight+    it "should be IsLeft for invalid CirclePlot." $ do+      let testInput = validatePlot $ def { cpConn = [[1,2],[3,4]], cpColor = Just [1,2] }+        in testInput `shouldSatisfy` isLeft+    it "should be IsRight for valid ForcePlot." $ do+      let testInput = validatePlot $ def { fpConn = [[1,2,3],[1,2,3],[1,2,3]], fpBrush = Just False }+        in testInput `shouldSatisfy` isRight+    it "should be IsLeft for invalid ForcePlot." $ do+      let testInput = validatePlot $ def { fpConn = [[], [1.0]] }+        in testInput `shouldSatisfy` isLeft+    it "should be IsRight for valid GraphPlot." $ do+      let testInput = validatePlot $ def { gpX = [1], gpY = [1], gpConn = [[1,2,3]] }+        in testInput `shouldSatisfy` isRight+    it "should be IsLeft for invalid GraphPlot." $ do+      let testInput = validatePlot $ def { gpX = [1], gpY = [1,2,3], gpConn = [[1,2,3]] }+        in testInput `shouldSatisfy` isLeft+    it "should be IsRight for HistogramPlot." $ do+      let testInput = validatePlot $ def { hpValues = [1,2,1,1,1,4], hpBins = Just [1,2,3] }+        in testInput `shouldSatisfy` isRight+    it "should be IsRight for valid LinePlot." $ do+      let testInput = validatePlot $ def { lpSeries = [[1,2,3]], lpColor = Just [244,0,100] }+        in testInput `shouldSatisfy` isRight+    it "should be IsLeft for invalid LinePlot." $ do+      let testInput = validatePlot $ def { lpSeries = [[1,2,3,4]], lpColor = Just [0] }+        in testInput `shouldSatisfy` isLeft+    it "should be IsRight for valid MapPlot." $ do+      let testInput = validatePlot $ def { mppRegions = ["USA","CAN"], mppWeights = [0.2,1.3] }+        in testInput `shouldSatisfy` isRight+    it "should be IsLeft for invalid MapPlot." $ do+      let testInput = validatePlot $ def { mppRegions = ["USA","CAN", "AL"], mppWeights = [0.2,1.3] }+        in testInput `shouldSatisfy` isLeft+    it "should be IsRight for valid MatrixPlot." $ do+      let testInput = validatePlot $ def { mpMatrix = [[1,2,3],[4,5,6]] }+        in testInput `shouldSatisfy` isRight+    it "should be IsLeft for invalid MatrixPlot." $ do+      let testInput = validatePlot $ def { mpMatrix = [[1,2,3],[4,5,6],[7,8,9]], mpColorMap = Just "NotAColorMap" }+        in testInput `shouldSatisfy` isLeft+    it "should be IsRight for valid ScatterPlot." $ do+      let testInput = validatePlot $ def { spX = [1,2,3], spY = [1,2,3] }+        in testInput `shouldSatisfy` isRight+    it "should be IsLeft for invalid ScatterPlot." $ do+      let testInput = validatePlot $ def { spX = [1,2,3], spY = [0,0,0], spAlpha = Just [-1,0,1] }+        in testInput `shouldSatisfy` isLeft+    it "should be IsRight for valid ScatterPlot3." $ do+      let testInput = validatePlot $ def { sptX = [1,2,3], sptY = [1,2,3], sptZ = [0,0,0] }+        in testInput `shouldSatisfy` isRight+    it "should be IsLeft for invalid ScatterPlot3." $ do+      let testInput = validatePlot $ def { sptX = [1,2,3], sptY = [0,0,0], sptZ = [1,2,3,4] }+        in testInput `shouldSatisfy` isLeft
+ test/Web/Lightning/UtilitySpec.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.Lightning.UtilitySpec where++import           Test.Hspec++import           Data.Aeson++import           Web.Lightning.Plots+import           Web.Lightning.Utilities++isRight :: Either a b -> Bool+isRight = const False `either` const True++isLeft :: Either a b -> Bool+isLeft = const True `either` const False++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "Lightning Utilities" $ do+    it "createPayLoad should wrap plot and type in JSON object" $ do+      let plotValue = toJSON $ def { lpSeries = [[1,2,3]]}+          payload = createPayLoad "line" plotValue+       in encode payload `shouldBe` "{\"data\":{\"series\":[[1,2,3]],\"zoom\":true},\"type\":\"line\"}"+    it "addSessionId appends session ID to URL" $ do+      addSessionId defaultBaseURL "1b95a317-088e-4deb-a415-76962356742b" `shouldBe` "http://localhost:3000/sessions/1b95a317-088e-4deb-a415-76962356742b"+    it "getPoints zips x and y points into x-y co-ordinates" $ do+      getPoints [1,2,3] [4,5,6] `shouldBe` [[1.0,4.0],[2.0,5.0],[3.0,6.0]]+    it "getPoints3 zips x, y, and z points into xyz co-ordinates" $ do+      getPoints3 [1,2,3] [4,5,6] [7,8,9] `shouldBe` [[1.0,4.0,7.0],[2.0,5.0,8.0],[3.0,6.0,9.0]]+    it "getNodes # of nodes from adjacency matrix" $ do+      getNodes [[1,2,3],[4,5,6],[7,8,9]] `shouldBe` [0,1,2]+    it "getLinks converts adjacency matrix to [source, target, value] form." $ do+      getLinks [[1,2],[3,4]] `shouldBe` [[0.0,0.0,1.0],[0.0,1.0,2.0],[1.0,0.0,3.0],[1.0,1.0,4.0]]++  describe "Plot Validation Utilities" $ do+    it "validateBin should be idempotent with Just value." $ do+      let test = validateBin $ Just [1.0,2.0,3.0]+        in test `shouldSatisfy` isRight+    it "validateBin should be idempotent with Nothing value." $ do+      let test = validateBin Nothing+        in test `shouldSatisfy` isRight+    it "validateColor should be IsRight with [r,g,b] value." $ do+      let test = validateColor $ Just [255,0,0]+        in test `shouldSatisfy` isRight+    it "validateColor should be IsLeft with [a,b,c,d] value." $ do+      let test = validateColor $ Just [255,0,0,0]+        in test `shouldSatisfy` isLeft+    it "validateColorMap should be IsRight with valid color map." $ do+      let test = validateColorMap $ Just "BrBG"+        in test `shouldSatisfy` isRight+    it "validateColorMap should be IsLeft with invalid color map." $ do+      let test = validateColorMap $ Just "NotValidColorMap"+        in test `shouldSatisfy` isLeft+    it "validateSize should be IsRight with positive values." $ do+      let test = validateSize $ Just [1,2,3]+        in test `shouldSatisfy` isRight+    it "validateSize should be IsLeft with 0 or below values." $ do+      let test = validateSize $ Just [0,0,-1]+        in test `shouldSatisfy` isLeft+    it "validateAlpha should be IsRight with positive values." $ do+      let test = validateAlpha $ Just [1,2,3]+        in test `shouldSatisfy` isRight+    it "validateAlpha should be IsLeft with 0 or below values." $ do+      let test = validateAlpha $ Just [-10,3,0]+        in test `shouldSatisfy` isLeft+    it "validateThickness should be IsRight with positive values." $ do+      let test = validateThickness $ Just [1,2,3]+        in test `shouldSatisfy` isRight+    it "validateThickness should be IsLeft with 0 or below values." $ do+      let test = validateThickness $ Just [-10,3,0]+        in test `shouldSatisfy` isLeft+    it "validateIndex should be IsRight with more than 1 element." $ do+      let test = validateIndex $ Just [1,2,3]+        in test `shouldSatisfy` isRight+    it "validateIndex should be IsLeft with no elements." $ do+      let test = validateIndex $ Just []+        in test `shouldSatisfy` isLeft+    it "validateCoordinates should be IsRight with equal vector lengths." $ do+      let test = validateCoordinates [1.0,2.0,3.0] [4.0,5.0,6.0]+        in test `shouldSatisfy` isRight+    it "validateCoordinates should be IsLeft with unqual vector lengths." $ do+      let test = validateCoordinates [1.0,2.0,3.0] [1.0,2.0]+        in test `shouldSatisfy` isLeft+    it "validateCoordinates3 should be IsRight with equal vector lengths." $ do+      let test = validateCoordinates3 [1.0,2.0,3.0] [4.0,5.0,6.0] [7.0,8.0,9.0]+        in test `shouldSatisfy` isRight+    it "validateCoordinates3 should be IsLeft with unqual vector lengths." $ do+      let test = validateCoordinates3 [1.0,2.0,3.0] [1.0,2.0] [1.0,2.0,3.0]+        in test `shouldSatisfy` isLeft+    it "validateRegion should be IsRight with all 2 letter words." $ do+      let test = validateRegion ["AL","AZ"]+        in test `shouldSatisfy` isRight+    it "validateRegion should be IsRight with all 3 letter words." $ do+      let test = validateRegion ["CAN","USA","MEX"]+        in test `shouldSatisfy` isRight+    it "validateRegion should be IsLeft with different word lengths." $ do+      let test = validateRegion ["CAN","AL"]+        in test `shouldSatisfy` isLeft+    it "validateConn should be IsRight with symmetric matrix." $ do+      let test = validateConn [[1.0,2.0,3.0],[4.0,5.0,6.0],[7.0,8.0,9.0]]+        in test `shouldSatisfy` isRight+    it "validateConn should be IsRight with node links." $ do+      let test = validateConn [[1.0,2.0],[2.0,3.0],[3.0,4.0]]+        in test `shouldSatisfy` isRight+    it "validateConn should be IsRight with node links and weights." $ do+      let test = validateConn [[1.0,2.0,0.6],[1.0,2.0,0.1]]+        in test `shouldSatisfy` isRight+    it "validateConn should be IsLeft with too many values in node pairing" $ do+      let test = validateConn [[1.0,2.0,3.0,4.0]]+        in test `shouldSatisfy` isLeft
+ test/Web/LightningSpec.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.LightningSpec where++import           Test.Hspec++import           Data.Maybe++import           Web.Lightning+import           Web.Lightning.Session++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "Lightning options API" $ do+    it "allows setting Lightning's API base URL" $ do+      let opts = setBaseURL "http://127.0.0.1:3000" defaultLightningOptions+       in optHostUrl opts `shouldBe` "http://127.0.0.1:3000"+    it "allows setting a session name" $ do+      let opts = setSessionName "test" defaultLightningOptions+          sess = fromJust $ optSession opts+       in fromJust (snName sess) `shouldBe` "test"+    it "allows setting a session id" $ do+      let opts = setSessionId "abc-xyz" defaultLightningOptions+          sess = fromJust $ optSession opts+       in snId sess `shouldBe` "abc-xyz"+    it "allows setting HTTP Basic Auth credentials" $ do+      let opts = setBasicAuth ("user", "secret") defaultLightningOptions+          (BasicAuth (_, p)) = optLoginMethod opts+       in p `shouldBe` "secret"