grafana (empty) → 0.1
raw patch · 5 files changed
+685/−0 lines, 5 filesdep +aesondep +aeson-prettydep +basesetup-changed
Dependencies added: aeson, aeson-pretty, base, bytestring, text
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- grafana.cabal +47/−0
- src/Grafana.hs +601/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for grafana-dashboarding++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Ethan Jones++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 chessai 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
+ grafana.cabal view
@@ -0,0 +1,47 @@+cabal-version: 2.2+name:+ grafana+version:+ 0.1+synopsis:+ grafana datatypes for dashboards+description:+ 'grafana' provides datatypes that correspond to components of+ grafana dashboards, and combinators for constructing dashboards.+ It should be suitable for a UI that allows users to construct+ grafana dashboards.+license:+ BSD-3-Clause+license-file:+ LICENSE+author:+ Ethan Jones+maintainer:+ Ethan Jones+category:+ Graphics, Tooling+extra-source-files:+ CHANGELOG.md++library+ exposed-modules:+ Grafana+ build-depends:+ , base >= 4.10 && < 4.13+ , bytestring >= 0.10 && < 0.11+ , aeson >= 1.3 && < 1.5+ , aeson-pretty >= 0.8 && < 0.9+ , text >= 1.2 && < 1.3+ hs-source-dirs:+ src+ default-language:+ Haskell2010+ ghc-options:+ -Wall+ -O2++source-repository head+ type:+ git+ location:+ git://github.com/chessai/grafana.git
+ src/Grafana.hs view
@@ -0,0 +1,601 @@+{-# language+ BangPatterns+ , BlockArguments+ , DeriveFoldable+ , DeriveFunctor+ , DeriveGeneric+ , DeriveTraversable+ , DerivingStrategies+ , GeneralizedNewtypeDeriving+ , LambdaCase+ , OverloadedStrings+ #-}++module Grafana+ ( ColumnSort(..)+ , Dashboard(..)+ , GraphiteQuery(..)+ , Gauge(..)+ , Sparkline(..)+ , UnitFormat(..)+ , Panel+ , PanelStyles(..)+ , PathComponent(..)+ , RGBA(..)+ , SortOrder(..)+ , StyleThresholds(..)+ , Templating(..)+ , TimeAmount(..)+ , TimeRange(..)+ , TimeUnit(..)++ , columns+ , defaultDashboard+ , defaultStyles+ , defaultGauge+ , defaultSparkline+ , getDashboardJSON+ , graph+ , layoutUniformPanels+ , maxDashboardWidth+ , move+ , panelAt+ , row+ , singlestatQuery+ , table+ , htmlPanel+ ) where++import Data.Aeson (ToJSON(..), FromJSON(..))+import Data.Aeson (Value(..), (.=), object)+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.ByteString (ByteString)+import Data.Char (isAlphaNum)+import Data.Coerce (coerce)+import Data.List.NonEmpty (NonEmpty)+import Data.Maybe (isJust, maybeToList)+import Data.Text (Text)+import Data.Word (Word8)+import GHC.Generics (Generic)++import qualified Data.Aeson as AE+import qualified Data.ByteString.Lazy as BL+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T++tshow :: Show a => a -> Text+tshow = T.pack . show+{-# inlineable tshow #-} -- not exported, should inline anyway++optionalField :: ToJSON a => Text -> Maybe a -> [(Text,AE.Value)]+optionalField key = \case+ Nothing -> []+ Just x -> [ key .= x ]++data Templating = Templating+ { templatingOptions :: NonEmpty Text+ , templatingName :: !Text+ , templatingLabel :: !Text+ , templatingQuery :: !GraphiteQuery+ , templatingAllValue :: !(Maybe Text)+ } deriving stock (Eq, Read, Show)++instance ToJSON Templating where+ toJSON t = object $+ [ "datasource" .= String "Graphite"+ , "includeAll" .= isJust (templatingAllValue t)+ , "type" .= String "query"+ , "regex" .= optionsRegex (templatingOptions t)+ , "name" .= templatingName t+ , "label" .= Null+ , "current" .= object+ [ "text" .= firstOption+ , "value" .= firstOption+ ]+ , "definition" .= query+ , "query" .= query+ , "options" .= Array mempty+ , "tagsQuery" .= String ""+ , "tags" .= Array mempty+ , "useTags" .= False+ , "hide" .= (0 :: Int)+ , "multi" .= False+ , "refresh" .= (2 :: Int)+ , "tagValuesQuery" .= String ""+ ]+ <> optionalField "allValue" (templatingAllValue t)+ where+ query = serializeQuery (templatingQuery t)+ firstOption = NE.head (templatingOptions t)++optionsRegex :: NonEmpty Text -> Text+optionsRegex options = "/"+ <> T.intercalate "|" (stripInvalidChars <$> NE.toList options)+ <> "/"++data UnitFormat+ = PercentUnitFormat+ | PercentFormat+ | DBmFormat+ | SecondsFormat+ | MillisecondsFormat+ deriving stock (Eq, Generic, Read, Show)++instance ToJSON UnitFormat where+ toJSON = \case+ PercentFormat -> "percent"+ PercentUnitFormat -> "percentunit"+ DBmFormat -> "dBm"+ SecondsFormat -> "s"+ MillisecondsFormat -> "ms"++data PanelType+ = GraphPanel+ | SinglestatPanel+ | TablePanel+ | HeatmapPanel+ | AlertListPanel+ | DashboardListPanel+ | TextPanel+ | RowPanel+ deriving stock (Eq, Generic, Read, Show)++instance ToJSON PanelType where+ toJSON = \case+ GraphPanel -> "graph"+ SinglestatPanel -> "singlestat"+ TablePanel -> "table"+ HeatmapPanel -> "heatmap"+ AlertListPanel -> "alertlist"+ DashboardListPanel -> "dashboardlist"+ TextPanel -> "text"+ RowPanel -> "row"++data GridPos = GridPos+ { panelWidth :: !Int+ , panelHeight :: !Int+ , panelXPosition :: !Int+ , panelYPosition :: !Int+ } deriving stock (Eq, Generic, Read, Show)++instance ToJSON GridPos where+ toJSON (GridPos w h x y) =+ object+ [ "w" .= w+ , "h" .= h+ , "x" .= x+ , "y" .= y+ ]++data Column = Column+ { columnLabel :: !Text+ , columnValue :: !Text+ } deriving stock (Eq, Generic, Read, Show)++instance ToJSON Column where+ toJSON (Column label value) =+ object+ [ "text" .= String label+ , "value" .= String value+ ]++columns :: [Text] -> [Column]+columns = fmap (\name -> Column (T.toTitle name) (T.toLower name))++newtype PanelColumns = PanelColumns (Maybe [Column])+ deriving stock (Eq, Generic, Read, Show)++instance ToJSON PanelColumns where+ toJSON (PanelColumns x) = case x of+ Nothing -> Array mempty+ Just xs -> toJSON xs++data Panel = Panel+ { panelQueryPanel :: !QueryPanel+ , panelGridPos :: !GridPos+ } deriving stock (Eq, Generic, Read, Show)++data RGBA+ = RGBA !Word8 !Word8 !Word8 !Double+ | RGB !Word8 !Word8 !Word8+ deriving stock (Eq, Generic, Read, Show)++instance ToJSON RGBA where+ toJSON (RGBA r g b a) = String $+ "rgba(" <>+ tshow r <> ", " <>+ tshow g <> ", " <>+ tshow b <> ", " <>+ tshow a <> ")"+ toJSON (RGB r g b) = String $+ "rgb(" <>+ tshow r <> ", " <>+ tshow g <> ", " <>+ tshow b <> ")"++newtype StyleThresholds a = StyleThresholds [a]+ deriving stock (Generic, Read, Show)+ deriving newtype (Eq, ToJSON, FromJSON)+ deriving newtype (Functor, Foldable)++instance Traversable StyleThresholds where+ traverse f = fmap StyleThresholds . traverse f . coerce+ {-# inline traverse #-}++data SortOrder+ = Ascending+ | Descending+ deriving stock (Eq, Generic, Read, Show)++data ColumnSort = ColumnSort !Int !SortOrder+ deriving stock (Eq, Generic, Read, Show)++data Gauge = Gauge+ { minValue :: !Int+ , maxValue :: !Int+ , thresholdMarkers :: !Bool+ , thresholdLabels :: !Bool+ } deriving stock (Eq, Generic, Read, Show)++defaultGauge :: Gauge+defaultGauge = Gauge+ { minValue = 0+ , maxValue = 100+ , thresholdMarkers = True+ , thresholdLabels = False+ }++instance ToJSON Gauge where+ toJSON g = object+ [ "minValue" .= minValue g+ , "maxValue" .= maxValue g+ , "thresholdMarkers" .= thresholdMarkers g+ , "thresholdLabels" .= thresholdLabels g+ , "show" .= True+ ]++data Sparkline = Sparkline+ { fillColor :: !RGBA+ , full :: !Bool+ , lineColor :: !RGBA+ } deriving stock (Eq, Generic, Read, Show)++defaultSparkline :: Sparkline+defaultSparkline = Sparkline+ { fillColor = RGBA 31 118 189 0.18+ , full = False+ , lineColor = RGB 31 120 193+ }++instance ToJSON Sparkline where+ toJSON s = object+ [ "fillColor" .= fillColor s+ , "full" .= full s+ , "lineColor" .= lineColor s+ , "show" .= True+ ]++data PanelStyles = PanelStyles+ { alias :: !Text+ , colorMode :: !Text+ , colors :: [RGBA]+ , columnsSort :: !(Maybe ColumnSort)+ , decimals :: !Int+ , fontsize :: !Int+ , styleThresholds :: !(StyleThresholds Double)+ , styleUnit :: !(Maybe UnitFormat)+ , transparent :: !Bool+ , gauge :: !(Maybe Gauge)+ , colorBackground :: !Bool+ , colorValue :: !Bool+ , sparkline :: !(Maybe Sparkline)+ } deriving stock (Eq, Generic, Read, Show)++defaultStyles :: PanelStyles+defaultStyles = PanelStyles+ { alias = ""+ , colorMode = "cell"+ , colors = []+ , columnsSort = Nothing+ , decimals = 2+ , fontsize = 80+ , styleThresholds = StyleThresholds []+ , styleUnit = Nothing+ , transparent = False+ , gauge = Nothing+ , colorBackground = True+ , colorValue = False+ , sparkline = Nothing+ }++instance ToJSON PanelStyles where+ toJSON o = object+ [ "alias" .= alias o+ , "colorMode" .= colorMode o+ , "colors" .= colors o+ , "decimals" .= decimals o+ , "unit" .= String "short"+ , "type" .= String "number"+ , "pattern" .= String "/.*/"+ , "thresholds" .= fmap tshow (styleThresholds o)+ , "unit" .= styleUnit o+ ]++data QueryPanel = QueryPanel+ { queryPanelType :: !PanelType+ , queryPanelTitle :: !Text+ , queryPanelQueries :: [GraphiteQuery]+ , queryPanelColumns :: !PanelColumns+ , queryPanelStyles :: !PanelStyles+ , queryPanelContent :: !Text+ } deriving stock (Eq, Generic, Read, Show)++instance ToJSON QueryPanel where+ toJSON = object . queryPanelToPairs++instance ToJSON ColumnSort where+ toJSON (ColumnSort n sortOrder) = object+ [ "col" .= n+ , "desc" .= (sortOrder == Descending)+ ]++queryPanelToPairs :: QueryPanel -> [(Text,AE.Value)]+queryPanelToPairs p =+ [ "type" .= queryPanelType p+ , "title" .= queryPanelTitle p+ , "targets" .= makeTargets (queryPanelQueries p)+ , "columns" .= queryPanelColumns p+ , "valueFontSize" .= (String $ tshow (fontsize (queryPanelStyles p)) <> "%")+ , "content" .= queryPanelContent p+ , "transparent" .= transparent (queryPanelStyles p)+ , "mode" .= String "html"+ ] <>+ case queryPanelType p of+ SinglestatPanel ->+ [ "format" .= styleUnit (queryPanelStyles p)+ , "thresholds" .=+ let (StyleThresholds xs) = styleThresholds (queryPanelStyles p)+ in T.intercalate "," (tshow <$> xs)+ , "colorBackground" .= colorBackground (queryPanelStyles p)+ , "colorValue" .= colorValue (queryPanelStyles p)+ , "colors" .= colors (queryPanelStyles p)+ ]+ <> optionalField "gauge" (gauge (queryPanelStyles p))+ <> optionalField "sparkline" (sparkline (queryPanelStyles p))+ TablePanel ->+ [ "styles" .= [queryPanelStyles p]+ , "transform" .= ("timeseries_aggregations" :: Text)+ ]+ <> optionalField "sort" (columnsSort (queryPanelStyles p))+ GraphPanel ->+ [ "nullPointMode" .= String "connected"+ ]+ _ -> []++instance ToJSON Panel where+ toJSON p = object $+ ( "gridPos" .= panelGridPos p ) : queryPanelToPairs (panelQueryPanel p)++data TimeUnit+ = Seconds+ | Minutes+ | Hours+ | Days+ deriving stock (Eq, Generic, Read, Show)++data TimeAmount = Interval !Int !TimeUnit+ deriving stock (Eq, Generic, Read, Show)++displayTimeAmount :: TimeAmount -> Text+displayTimeAmount (Interval n units) =+ case units of+ Seconds -> (tshow n <> "s")+ Minutes -> (tshow n <> "m")+ Hours -> (tshow n <> "h")+ Days -> (tshow n <> "d")++instance ToJSON TimeAmount where+ toJSON = String . displayTimeAmount++data TimeRange = TimeRange+ { rangeFrom :: !TimeAmount+ , rangeTo :: !(Maybe TimeAmount)+ } deriving stock (Eq, Generic, Read, Show)++instance ToJSON TimeRange where+ toJSON range =+ object+ [ "from" .= ("now-" <> displayTimeAmount (rangeFrom range))+ , "to" .=+ case rangeTo range of+ Nothing -> "now"+ Just r -> "now-" <> displayTimeAmount r+ ]++maxDashboardWidth :: Int+maxDashboardWidth = 24++data Dashboard = Dashboard+ { dashboardIdentifier :: !(Maybe Int)+ , dashboardUid :: !(Maybe Text)+ , dashboardTitle :: !Text+ , dashboardTime :: !TimeRange+ , dashboardRefresh :: !TimeAmount+ , dashboardVersion :: !Int+ , dashboardPanels :: [Panel]+ , dashboardTemplating :: [Templating]+ , dashboardLinks :: [Link]+ , dashboardTags :: [Text]+ } deriving stock (Eq, Generic, Read, Show)++instance ToJSON Dashboard where+ toJSON g = object $+ [ "panels" .= dashboardPanels g+ , "title" .= dashboardTitle g+ , "time" .= dashboardTime g+ , "templating" .= object+ [ "list" .= dashboardTemplating g+ ]+ , "links" .= dashboardLinks g+ , "tags" .= dashboardTags g+ ] <> maybeToList (("uid" .=) <$> dashboardUid g)++defaultDashboard :: Dashboard+defaultDashboard = Dashboard+ { dashboardIdentifier = Nothing+ , dashboardUid = Nothing+ , dashboardTitle = "New dashboard"+ , dashboardPanels = []+ , dashboardTime = TimeRange (Interval 1 Hours) Nothing+ , dashboardRefresh = Interval 5 Seconds+ , dashboardVersion = 1+ , dashboardTemplating = []+ , dashboardLinks = []+ , dashboardTags = []+ }++data Target = Target+ { refId :: !Text+ , targetVal :: !Text+ } deriving (Eq, Generic, Read, Show)++instance ToJSON Target where+ toJSON g =+ object+ [ "refId" .= refId g+ , "target" .= targetVal g+ ]++data Link = Link+ { tags :: [Text]+ , title :: !Text+ } deriving (Eq, Generic, Read, Show)++instance ToJSON Link where+ toJSON g =+ object+ [ "asDropdown" .= True+ , "icon" .= String "external link"+ , "tags" .= tags g+ , "title" .= title g+ , "type" .= String "dashboards"+ ]++makeTargets :: [GraphiteQuery] -> [Target]+makeTargets = zipWith+ (\refid query -> Target refid (serializeQuery query))+ refids+ where+ refids = T.singleton <$> (repeat 'A')++table :: PanelStyles -> Text -> [Column] -> ColumnSort -> [GraphiteQuery] -> QueryPanel+table style label cols colSort queries = QueryPanel+ TablePanel+ label+ queries+ (PanelColumns $ Just cols)+ (style { columnsSort = Just colSort })+ ""++graph :: Text -> [GraphiteQuery] -> QueryPanel+graph label queries = QueryPanel+ GraphPanel+ label+ queries+ (PanelColumns Nothing)+ defaultStyles+ ""++row :: Text -> QueryPanel+row label = QueryPanel+ RowPanel+ label+ []+ (PanelColumns Nothing)+ defaultStyles+ ""++data GraphiteQuery+ = HighestCurrent GraphiteQuery !Int+ | AverageSeriesWithWildcards GraphiteQuery !Int+ | AliasSub GraphiteQuery !Text !Text+ | Avg GraphiteQuery+ | Metric [PathComponent Text]+ | LiteralQuery !Text+ deriving stock (Eq, Read, Show)++serializeQuery :: GraphiteQuery -> Text+serializeQuery (HighestCurrent q n) =+ "highestCurrent(" <> serializeQuery q <> "," <> tshow n <> ")"+serializeQuery (AverageSeriesWithWildcards q n) =+ "averageSeriesWithWildcards(" <> serializeQuery q <> "," <> tshow n <> ")"+serializeQuery (AliasSub q a b) =+ "aliasSub(" <> serializeQuery q <> ",'" <> a <> "','" <> b <> "')"+serializeQuery (Avg q) = "avg(" <> serializeQuery q <> ")"+serializeQuery (Metric xs) = T.intercalate "."+ (serializePathComponent . fmap stripInvalidChars <$> xs)+serializeQuery (LiteralQuery t) = t++stripInvalidChars :: Text -> Text+stripInvalidChars = T.filter (\c -> isAlphaNum c || c == '-' || c == '_')++data PathComponent a+ = Anything+ | Variable !Text+ | Literal a+ | OneOf [a]+ deriving stock (Eq, Ord, Read, Show)+ deriving stock (Functor, Foldable, Traversable)++serializePathComponent :: PathComponent Text -> Text+serializePathComponent = \case+ Anything -> "*"+ Variable v -> "$" <> v+ Literal name -> name+ OneOf xs -> "{" <> T.intercalate "," xs <> "}"++getDashboardJSON :: Dashboard -> ByteString+getDashboardJSON = BL.toStrict . encodePretty++htmlPanel :: Text -> QueryPanel+htmlPanel content = QueryPanel+ TextPanel+ ""+ []+ (PanelColumns Nothing)+ defaultStyles { transparent = True }+ content++singlestatQuery :: PanelStyles -> Text -> [GraphiteQuery] -> QueryPanel+singlestatQuery style label queries = QueryPanel+ SinglestatPanel+ label+ queries+ (PanelColumns Nothing)+ style+ ""++panelAt :: Int -> Int -> Int -> Int -> QueryPanel -> [Panel]+panelAt left top width height queryPanel =+ [ Panel+ queryPanel+ (GridPos width height left top)+ ]++move :: Int -> Int -> Panel -> Panel+move dx dy panel =+ let+ GridPos w h x y = panelGridPos panel+ newPos = GridPos w h (x + dx) (y + dy)+ in+ panel { panelGridPos = newPos }++layoutUniformPanels :: Int -> Int -> Int -> Int -> [QueryPanel] -> [Panel]+layoutUniformPanels left top width height queryPanels =+ zipWith+ Panel+ queryPanels+ [ GridPos width height x y+ | y <- [top, height..]+ , x <- [left, width..maxDashboardWidth-1]+ ]