Utilities.hs

{-# 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"