grafana 0.1 → 0.2

raw patch · 6 files changed

+790/−225 lines, 6 filesdep +Diffdep +containersdep +grafanadep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: Diff, containers, grafana, tasty, tasty-hunit

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−1
• grafana.cabal +46/−41
• src/Grafana.hs +388/−183
• src/Grafana/Layout.hs +80/−0
• src/Grafana/Plugin/PieChart.hs +42/−0
• test/UnitTests.hs +231/−0

@@ -1,5 +1,7 @@ # Revision history for grafana-dashboarding -## 0.1.0.0 -- YYYY-mm-dd+## 0.2+Add Layout and Plugin machinery. +## 0.1 * First version. Released on an unsuspecting world.

@@ -1,47 +1,52 @@ cabal-version: 2.2-name:-  grafana-version:-  0.1-synopsis:-  grafana datatypes for dashboards+name: grafana+version: 0.2+license: BSD-3-Clause+license-file: LICENSE+maintainer: Ethan Jones+author: Ethan Jones+synopsis: API for creating grafana dashboards represented as json 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+    '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.+category: Graphics, Tooling extra-source-files:-  CHANGELOG.md+    CHANGELOG.md +source-repository head+    type: git+    location: git://github.com/chessai/grafana.git+ 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+    exposed-modules:+        Grafana+        Grafana.Layout+        Grafana.Plugin.PieChart+    hs-source-dirs: src+    default-language: Haskell2010+    ghc-options: -Wall+    build-depends:+        base >=4.10 && <4.13,+        bytestring >=0.10 && <0.11,+        aeson >=1.3 && <1.5,+        aeson-pretty >=0.8 && <0.9,+        containers -any,+        text >=1.2 && <1.3 -source-repository head-  type:-    git-  location:-    git://github.com/chessai/grafana.git+test-suite unit+    type: exitcode-stdio-1.0+    main-is: UnitTests.hs+    hs-source-dirs: test+    default-language: Haskell2010+    ghc-options: -Wall+    build-depends:+        aeson >=1.3 && <1.5,+        aeson-pretty >=0.8 && <0.9,+        base ^>=4.12.0.0,+        bytestring >=0.10 && <0.11,+        Diff -any,+        grafana -any,+        tasty -any,+        tasty-hunit -any

@@ -9,41 +9,65 @@       , GeneralizedNewtypeDeriving       , LambdaCase       , OverloadedStrings+      , RecordWildCards   #-}  module Grafana-  ( ColumnSort(..)+  ( ColorMode(..)+  , ColumnSort(..)+  , ColumnStyles(..)   , Dashboard(..)   , GraphiteQuery(..)   , Gauge(..)-  , Sparkline(..)-  , UnitFormat(..)-  , Panel-  , PanelStyles(..)+  , Graph(..)+  , GridPos(..)+  , Heatmap(..)+  , NullPointMode(..)+  , Panel(..)+  , PanelConfig   , PathComponent(..)   , RGBA(..)+  , Row(..)+  , Singlestat(..)   , SortOrder(..)+  , Sparkline(..)   , StyleThresholds(..)+  , Table(..)+  , TableTransform(..)+  , Target(..)   , Templating(..)   , TimeAmount(..)   , TimeRange(..)   , TimeUnit(..)+  , UnitFormat(..)    , columns   , defaultDashboard   , defaultStyles   , defaultGauge+  , defaultGraph+  , defaultHeatmap+  , defaultSinglestat   , defaultSparkline+  , defaultTable   , getDashboardJSON-  , graph-  , layoutUniformPanels+  , makeTargets   , maxDashboardWidth   , move-  , panelAt+   , row-  , singlestatQuery+  , rowPanel+  , graph+  , graphPanel+  , heatmap+  , heatmapPanel   , table-  , htmlPanel+  , tablePanel+  , text+  , textPanel+  , serializeQuery+  , singlestat+  , singlestatPanel   ) where  import Data.Aeson (ToJSON(..), FromJSON(..))@@ -63,11 +87,13 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Text as T +type PanelConfig = [(Text, AE.Value)]+ 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 :: ToJSON a => Text -> Maybe a -> PanelConfig optionalField key = \case   Nothing -> []   Just x -> [ key .= x ]@@ -109,16 +135,21 @@       firstOption = NE.head (templatingOptions t)  optionsRegex :: NonEmpty Text -> Text-optionsRegex options = "/"+optionsRegex options = "/^("   <> T.intercalate "|" (stripInvalidChars <$> NE.toList options)-  <> "/"+  <> ")$/"  data UnitFormat   = PercentUnitFormat   | PercentFormat   | DBmFormat+  | DbFormat   | SecondsFormat   | MillisecondsFormat+  | BpsFormat+  | ShortFormat+  | NoFormat+  | OtherFormat Text   deriving stock (Eq, Generic, Read, Show)  instance ToJSON UnitFormat where@@ -126,30 +157,13 @@     PercentFormat -> "percent"     PercentUnitFormat -> "percentunit"     DBmFormat -> "dBm"+    DbFormat -> "dB"     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"+    BpsFormat -> "bps"+    ShortFormat -> "short"+    NoFormat -> "none"+    OtherFormat t -> String t  data GridPos = GridPos   { panelWidth :: !Int@@ -190,11 +204,6 @@     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@@ -275,106 +284,193 @@     , "show" .= True     ] -data PanelStyles = PanelStyles+data StyleType+  = NumberStyleType+  | StringStyleType+  | DateStyleType+  | HiddenStyleType+  deriving (Eq, Show)++instance ToJSON StyleType where+  toJSON = \case+    NumberStyleType -> "number"+    StringStyleType -> "string"+    DateStyleType -> "date"+    HiddenStyleType -> "hidden"++data ColumnStyles = ColumnStyles   { alias :: !Text-  , colorMode :: !Text+  , colorMode :: !ColorMode   , 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)+  , patternRegex :: !Text+  , thresholds :: !(StyleThresholds Double)+  , unit :: !UnitFormat+  , styleType :: StyleType+  , dateFormat :: Maybe Text+  }+  deriving (Eq, Show) -defaultStyles :: PanelStyles-defaultStyles = PanelStyles+data ColorMode+  = ColorDisabled+  | ColorCell+  | ColorValue+  | ColorRow+  deriving (Eq, Show)++instance ToJSON ColorMode where+  toJSON = \case+    ColorDisabled -> Null+    ColorCell -> String "cell"+    ColorValue -> String "value"+    ColorRow -> String "row"++defaultStyles :: ColumnStyles+defaultStyles = ColumnStyles   { alias = ""-  , colorMode = "cell"+  , colorMode = ColorDisabled   , colors = []-  , columnsSort = Nothing+  , dateFormat = Nothing   , decimals = 2-  , fontsize = 80-  , styleThresholds = StyleThresholds []-  , styleUnit = Nothing-  , transparent = False-  , gauge = Nothing-  , colorBackground = True-  , colorValue = False-  , sparkline = Nothing+  , patternRegex = "/.*/"+  , styleType = NumberStyleType+  , thresholds = StyleThresholds []+  , unit = ShortFormat   } -instance ToJSON PanelStyles where+data Thresholds = Thresholds Double Double+  deriving (Eq, Show)++instance ToJSON Thresholds where+  toJSON (Thresholds l u) = String (tshow l <> "," <> tshow u)++defaultSinglestat :: Singlestat+defaultSinglestat = Singlestat+  { singlestatTitle = ""+  , singlestatQueries = []+  , singlestatFontSize = 100+  , singlestatUnit = NoFormat+  , singlestatColorBackground = False+  , singlestatColorValue = True+  , singlestatColors = []+  , singlestatGauge = Nothing+  , singlestatSparkline = Nothing+  , singlestatThresholds = Nothing+  }++instance ToJSON ColumnStyles 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+    , "unit" .= unit o+    , "type" .= styleType o+    , "pattern" .= patternRegex o+    , "thresholds" .= fmap tshow (thresholds 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"-        ]-      _ -> []+row :: Row -> PanelConfig+row (Row t) = [ "type" .= String "row", "title" .= t ] +singlestat :: Singlestat -> PanelConfig+singlestat (Singlestat {..}) =+    [ "type" .= String "singlestat"+    , "title" .= singlestatTitle+    , "targets" .= makeTargets singlestatQueries+    , "valueFontSize" .= singlestatFontSize+    , "format" .= singlestatUnit+    , "colorBackground" .= singlestatColorBackground+    , "colorValue" .= singlestatColorValue+    , "colors" .= singlestatColors+    ]+    <> optionalField "gauge" singlestatGauge+    <> optionalField "sparkline" singlestatSparkline+    <> optionalField "thresholds" singlestatThresholds++table :: Table -> PanelConfig+table (Table {..}) =+    [ "type" .= String "table"+    , "title" .= tableTitle+    , "targets" .= makeTargets tableQueries+    , "columns" .= tableColumns+    , "valueFontSize" .= tableFontSize+    , "styles" .= tableStyles+    , "transform" .= tableTransform+    ]+    <> optionalField "sort" tableSort++graph :: Graph -> PanelConfig+graph (Graph {..}) =+  [ "type" .= String "graph"+  , "title" .= graphTitle+  , "targets" .= makeTargets graphQueries+  , "nullPointMode" .= graphNullPointMode+  , "bars" .= graphHasBars+  , "steppedLine" .= graphHasSteppedLine+  ]+  <> case graphUnit of+       Nothing -> []+       Just su ->+         [ "yaxes" .=+           [ object+               [ "format" .= su+               , "label" .= Null+               , "logBase" .= Number 1+               , "max" .= Null+               , "min" .= Null+               , "show" .= True+               ]+           , object+               [ "format" .= String "short"+               , "label" .= Null+               , "logBase" .= Number 1+               , "max" .= Null+               , "min" .= Null+               , "show" .= True+               ]+           ]+         ]++rowPanel :: Row -> GridPos -> Panel+rowPanel = Panel . row++graphPanel :: Graph -> GridPos -> Panel+graphPanel = Panel . graph++tablePanel :: Table -> GridPos -> Panel+tablePanel = Panel . table++textPanel :: TextPanel -> GridPos -> Panel+textPanel = Panel . text++singlestatPanel :: Singlestat -> GridPos -> Panel+singlestatPanel = Panel . singlestat+++text :: TextPanel -> PanelConfig+text (TextPanel {..}) =+  [ "type" .= String "text"+  , "title" .= textTitle+  , "content" .= textContent+  , "transparent" .= textIsTransparent+  ]++data Panel = Panel+  { panelObject :: PanelConfig+  , panelGridPos :: GridPos+  }+  deriving stock (Eq, Generic, Read, Show)+ instance ToJSON Panel where   toJSON p = object $-    ( "gridPos" .= panelGridPos p ) : queryPanelToPairs (panelQueryPanel p)+    ( "gridPos" .= panelGridPos p ) : panelObject p  data TimeUnit   = Seconds@@ -486,55 +582,128 @@   (\refid query -> Target refid (serializeQuery query))   refids   where-    refids = T.singleton <$> (repeat 'A')+    refids = fmap (\n -> "I" <> tshow n) [(0 :: Int) ..] -table :: PanelStyles -> Text -> [Column] -> ColumnSort -> [GraphiteQuery] -> QueryPanel-table style label cols colSort queries = QueryPanel-  TablePanel-  label-  queries-  (PanelColumns $ Just cols)-  (style { columnsSort = Just colSort })-  ""+data Table = Table+  { tableTitle :: Text+  , tableQueries :: [GraphiteQuery]+  , tableColumns :: [Column]+  , tableSort :: Maybe ColumnSort+  , tableFontSize :: Int+  , tableStyles :: [ColumnStyles]+  , tableTransform :: TableTransform+  }+  deriving (Eq, Show) -graph :: Text -> [GraphiteQuery] -> QueryPanel-graph label queries = QueryPanel-  GraphPanel-  label-  queries-  (PanelColumns Nothing)-  defaultStyles-  ""+defaultTable :: Table+defaultTable = Table+  { tableTitle = ""+  , tableQueries = []+  , tableColumns = []+  , tableSort = Nothing+  , tableFontSize = 100+  , tableStyles = []+  , tableTransform = TimeSeriesAggregations+  } -row :: Text -> QueryPanel-row label = QueryPanel-  RowPanel-  label-  []-  (PanelColumns Nothing)-  defaultStyles-  ""+data TableTransform+  = TimeSeriesToColumns+  | TimeSeriesToRows+  | TimeSeriesAggregations+  deriving (Eq, Show) +instance ToJSON TableTransform where+  toJSON = \case+    TimeSeriesToColumns -> "timeseries_to_columns"+    TimeSeriesToRows -> "timeseries_to_rows"+    TimeSeriesAggregations -> "timeseries_aggregations"++data NullPointMode = Connected++instance ToJSON NullPointMode where+  toJSON Connected = String "connected"++data Graph = Graph+  { graphTitle :: Text+  , graphQueries :: [GraphiteQuery]+  , graphNullPointMode :: NullPointMode+  , graphUnit :: Maybe UnitFormat+  , graphHasBars :: Bool+  , graphHasSteppedLine :: Bool+  }++defaultGraph :: Graph+defaultGraph = Graph+  { graphTitle = ""+  , graphQueries = []+  , graphNullPointMode = Connected+  , graphUnit = Nothing+  , graphHasBars = False+  , graphHasSteppedLine = False+  }++data TextPanel = TextPanel+  { textTitle :: Text+  , textContent :: Text+  , textMode :: TextMode+  , textIsTransparent :: Bool+  }++data TextMode = Markdown | Html++instance ToJSON TextMode where+  toJSON = \case+    Markdown -> "markdown"+    Html -> "html"++data Singlestat = Singlestat+  { singlestatTitle :: Text+  , singlestatQueries :: [GraphiteQuery]+  , singlestatFontSize :: Int+  , singlestatUnit :: UnitFormat+  , singlestatColorBackground :: Bool+  , singlestatColorValue :: Bool+  , singlestatColors :: [RGBA]+  , singlestatGauge :: Maybe Gauge+  , singlestatSparkline :: Maybe Sparkline+  , singlestatThresholds :: Maybe Thresholds+  }+  deriving (Eq, Show)++newtype Row = Row Text+ data GraphiteQuery   = HighestCurrent GraphiteQuery !Int   | AverageSeriesWithWildcards GraphiteQuery !Int   | AliasSub GraphiteQuery !Text !Text+  | Alias GraphiteQuery !Text   | Avg GraphiteQuery+  | Absolute GraphiteQuery+  | Offset GraphiteQuery !Int   | 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+serializeQuery = \case+  HighestCurrent q n ->+    "highestCurrent(" <> serializeQuery q <> "," <> tshow n <> ")"+  AverageSeriesWithWildcards q n ->+    "averageSeriesWithWildcards(" <> serializeQuery q <> "," <> tshow n <> ")"+  AliasSub q a b ->+    "aliasSub(" <> serializeQuery q <> ",'" <> a <> "','" <> b <> "')"+  Alias q a ->+    "alias(" <> serializeQuery q <> ",'" <> a <> "')"+  Avg q ->+    "avg(" <> serializeQuery q <> ")"+  Absolute q ->+    "absolute(" <> serializeQuery q <> ")"+  Offset q n ->+    "offset(" <> serializeQuery q <> "," <> tshow n <> ")"+  Metric xs ->+    T.intercalate "." (serializePathComponent . fmap stripInvalidChars <$> xs)+  LiteralQuery t ->+    t  stripInvalidChars :: Text -> Text stripInvalidChars = T.filter (\c -> isAlphaNum c || c == '-' || c == '_')@@ -557,31 +726,6 @@ 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@@ -590,12 +734,73 @@   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]+data Heatmap = Heatmap+  { heatmapColor :: HeatmapColor+  , heatmapTitle :: Text+  , heatmapTargets :: [GraphiteQuery]+  , heatmapDataFormat :: HeatmapDataFormat+  }++defaultHeatmap :: Heatmap+defaultHeatmap = Heatmap+  { heatmapColor = defaultHeatmapColor+  , heatmapTitle = ""+  , heatmapTargets = []+  , heatmapDataFormat = TsBuckets+  }++heatmap :: Heatmap -> PanelConfig+heatmap Heatmap {..} =+    [ "type" .= String "heatmap"+    , "title" .= heatmapTitle+    , "color" .= heatmapColor+    , "dataFormat" .= heatmapDataFormat+    , "tooltip" .= object [ "show" .= False, "showHistogram" .= False ]     ]++heatmapPanel :: Heatmap -> GridPos -> Panel+heatmapPanel = Panel . heatmap++data HeatmapColor = HeatmapColor+  { heatmapColorScheme :: HeatmapColorScheme+  , heatmapMin :: Maybe Double+  , heatmapMax :: Maybe Double+  } deriving (Generic, Show)++instance ToJSON HeatmapColor where+  toJSON o = object $+    [ "mode" .= String "spectrum"+    , "cardColor" .= RGB 0xb4 0xff 0x00+    , "colorScale" .= String "sqrt"+    , "exponent" .= Number 0.5+    , "colorScheme" .= heatmapColorScheme o+    ]+    <> optionalField "min" (heatmapMin o)+    <> optionalField "max" (heatmapMax o)++defaultHeatmapColor :: HeatmapColor+defaultHeatmapColor = HeatmapColor+  { heatmapColorScheme = Oranges+  , heatmapMax = Nothing+  , heatmapMin = Nothing+  }++data HeatmapColorScheme+  = Oranges+  | RdYlGn+  deriving (Generic, Show)++instance ToJSON HeatmapColorScheme where+  toJSON = \case+    Oranges -> String "interpolateOranges"+    RdYlGn -> String "interpolateRdYlGn"++data HeatmapDataFormat+  = Timeseries+  | TsBuckets+  deriving (Generic, Show)++instance ToJSON HeatmapDataFormat where+  toJSON = \case+    Timeseries -> String "timeseries"+    TsBuckets -> String "tsbuckets"

@@ -0,0 +1,80 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}++module Grafana.Layout where++import Data.Bifunctor+import Data.Foldable++data Pos = Pos !Int !Int+  deriving (Eq, Show)++data Rect = Rect+  { left :: !Int+  , right :: !Int+  , top :: !Int+  , bottom :: !Int+  } deriving (Eq, Show)++instance Semigroup Rect where+  Rect l r t b <> Rect l' r' t' b' =+    Rect (min l l') (max r r') (min t t') (max b b')++data Layout a+  = Layout [(Rect, a)] Rect+  | Empty+  deriving (Eq, Show, Functor)++instance Semigroup (Layout a) where+  Layout ars ab <> Layout brs bb = Layout (ars <> brs) (ab <> bb)+  a <> Empty = a+  Empty <> a = a++instance Monoid (Layout a) where+  mempty = Empty++moveLayout :: Pos -> Layout a -> Layout a+moveLayout _ Empty = Empty+moveLayout p (Layout xs rect) =+  Layout+    (map (first (moveRect p)) xs)+    (moveRect p rect)++moveRect :: Pos -> Rect -> Rect+moveRect (Pos x y) (Rect l r t b) = Rect (l + x) (r + x) (t + y) (b + y)++atop :: Layout a -> Layout a -> Layout a+atop a b = a <> moveLayout (Pos 0 (bottoml a)) b++nextTo :: Layout a -> Layout a -> Layout a+nextTo a b = a <> moveLayout (Pos (rightl a) 0) b++rightl :: Layout a -> Int+rightl Empty = 0+rightl (Layout _ r) = right r++bottoml :: Layout a -> Int+bottoml Empty = 0+bottoml (Layout _ r) = bottom r++rowFits :: Int -> Int -> Int -> [Rect]+rowFits maxWidth itemCount rowHeight =+  fmap (\x -> Rect x (x+width) 0 rowHeight) xs+  where+    xs = [padding, width + padding..]+    width = maxWidth `div` itemCount+    padding = maxWidth `mod` itemCount `div` 2++fitToRow :: Int -> Int -> [Rect -> Layout a] -> Layout a+fitToRow maxWidth rowHeight items = fold $+  zipWith ($) items (rowFits maxWidth (length items) rowHeight)++fillRows :: Int -> Int -> Int -> [Rect -> Layout a] -> Layout a+fillRows maxWidth rowHeight cols items+  | null thisRow = Empty+  | otherwise =+      fold (zipWith ($) thisRow (rowFits maxWidth cols rowHeight))+        `atop` fillRows maxWidth rowHeight cols rest+  where+  (thisRow, rest) = splitAt cols items

@@ -0,0 +1,42 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Grafana.Plugin.PieChart where++import Data.Aeson (ToJSON(..))+import Data.Aeson ((.=), Value(..))+import Data.Map.Strict (Map)+import Data.Text (Text)++import qualified Data.Aeson as AE++import Grafana++data PieType = Donut | Pie++instance ToJSON PieType where+  toJSON = \case+    Donut -> "donut"+    Pie -> "pie"++data PieChart = PieChart+  { pieChartTitle :: Text+  , pieChartQueries :: [GraphiteQuery]+  , pieChartUnit :: Maybe UnitFormat+  , pieChartAliasColors :: Map Text RGBA+  , pieType :: PieType+  }++pieChartToPairs :: PieChart -> [(Text, AE.Value)]+pieChartToPairs (PieChart {..}) =+  [ "type" .= String "grafana-piechart-panel"+  , "title" .= pieChartTitle+  , "targets" .= makeTargets pieChartQueries+  , "format" .= pieChartUnit+  , "pieType" .= pieType+  , "aliasColors" .= pieChartAliasColors+  ]++pieChartPanel :: PieChart -> GridPos -> Panel+pieChartPanel = Panel . pieChartToPairs

@@ -0,0 +1,231 @@+{-# language+        LambdaCase+      , OverloadedStrings+#-}++module Main (main) where++import Data.Aeson ((.=), Value(..), object, toJSON)+import Data.Aeson.Encode.Pretty (encodePretty)+import Data.Algorithm.Diff (getGroupedDiff)+import Data.Algorithm.DiffOutput (ppDiff)+import Data.Foldable (toList)+import Data.List (group, sort)+import Test.Tasty+import Test.Tasty.HUnit++import qualified Data.ByteString.Lazy.Char8 as BC8++import Grafana+import Grafana.Plugin.PieChart++main :: IO ()+main = defaultMain (testGroup "Tests" [unitTests])++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [ testCase "makeTargets makes distinct refIds" makeTargetsDistinctRefids+  , graphiteQuerySerialize+  , panelSerialize+  ]++makeTargetsDistinctRefids :: Assertion+makeTargetsDistinctRefids =+  let query1 = Metric [Literal "a", Literal "b", Literal "c"]+      query2 = Metric [Literal "d", Literal "e", Literal "f"]+      targets = makeTargets [query1, query2]+  in  distinctOn refId targets @? "Non-distinct refids"++distinctOn :: (Eq b, Ord b, Foldable t) => (a -> b) -> t a -> Bool+distinctOn predicate collection =+  all isSingleton . group . sort . map predicate . toList $ collection+  where+    isSingleton = \case+      [_] -> True+      _ -> False++graphiteQuerySerialize :: TestTree+graphiteQuerySerialize = testGroup "graphite queries are serialized properly"+  [ testCase "alias" serializeAlias+  , testCase "aliasSub" serializeAliasSub+  , testCase "escaping chars" serializeEscapesBadChars+  ]++serializeAlias :: Assertion+serializeAlias =+  let query = Alias (Metric [Anything, Anything, Anything]) "Something else"+  in  serializeQuery query @?= "alias(*.*.*,'Something else')"++serializeAliasSub :: Assertion+serializeAliasSub =+  let query = AliasSub (Metric [Anything, Anything, Anything]) "X" "Y"+  in  serializeQuery query @?= "aliasSub(*.*.*,'X','Y')"++serializeEscapesBadChars :: Assertion+serializeEscapesBadChars =+  let query = Metric [Literal "minipops 67 [120.2][source field mix]"]+  in  serializeQuery query @?= "minipops671202sourcefieldmix"++panelSerialize :: TestTree+panelSerialize = testGroup "Panel serialization"+  [ testCase "row serialization" rowSerialize+  , testCase "graph serialization" graphSerialize+  , testCase "table serialization" tableSerialize+  , testCase "pie chart serialization" pieChartSerialize+  , testCase "dashboard serialization" dashboardSerialize+  ]++defGridPos :: GridPos+defGridPos = GridPos 1 1 0 0++defGridPosJSON :: Value+defGridPosJSON =+  object+    [ "h" .= Number 1+    , "w" .= Number 1+    , "x" .= Number 0+    , "y" .= Number 0+    ]++defQueries :: [GraphiteQuery]+defQueries =+  [ Metric [Anything, Anything, Anything]+  , Metric [Anything, Anything, Anything]+  ]++defQueriesJSON :: [Value]+defQueriesJSON =+  [ object ["refId" .= String "I0", "target" .= String "*.*.*"]+  , object ["refId" .= String "I1", "target" .= String "*.*.*"]+  ]++assertEqJSON :: Value -> Value -> Assertion+assertEqJSON a b =+  let prettyJSON = lines . BC8.unpack . encodePretty+      diff = ppDiff (getGroupedDiff (prettyJSON a) (prettyJSON b))+  in  (a == b) @? diff++rowSerialize :: Assertion+rowSerialize =+  assertEqJSON+    (toJSON (rowPanel (Row "name") defGridPos))+    (object+      [ "gridPos" .= defGridPosJSON+      , "title" .= String "name"+      , "type" .= String "row"+      ])++graphSerialize :: Assertion+graphSerialize =+  assertEqJSON+    (toJSON (graphPanel+      (defaultGraph { graphTitle = "name", graphQueries = defQueries })+      defGridPos))+    (object+      [ "gridPos" .= defGridPosJSON+      , "title" .= String "name"+      , "type" .= String "graph"+      , "nullPointMode" .= Connected+      , "targets" .= defQueriesJSON+      , "bars" .= False+      , "steppedLine" .= False+      ])++tableSerialize :: Assertion+tableSerialize =+  let+    testTable = defaultTable+      { tableTitle = "name"+      , tableQueries = defQueries+      , tableColumns = columns ["Avg", "Current"]+      , tableStyles =+          [ defaultStyles+              { thresholds = StyleThresholds [5, 10]+              , decimals = 2+              , unit = PercentFormat+              , colorMode = ColorCell+              }+          ]+      }+  in+    assertEqJSON+      (toJSON (tablePanel testTable defGridPos))+      (object+        [ "gridPos" .= defGridPosJSON+        , "title" .= String "name"+        , "type" .= String "table"+        , "styles" .=+            [ object+                [ "pattern" .= String "/.*/"+                , "alias" .= String ""+                , "thresholds" .= [String "5.0", String "10.0"]+                , "decimals" .= Number 2+                , "type" .= String "number"+                , "colorMode" .= String "cell"+                , "colors" .= Array mempty+                , "unit" .= String "percent"+                ]+            ]+        , "targets" .= defQueriesJSON+        , "columns" .=+            [ object ["text" .= String "Avg", "value" .= String "avg"]+            , object ["text" .= String "Current", "value" .= String "current"]+            ]+        , "valueFontSize" .= Number 100+        , "transform" .= String "timeseries_aggregations"+        ])++pieChartSerialize :: Assertion+pieChartSerialize =+  let+    pieChart = PieChart+      { pieChartTitle = "name"+      , pieChartQueries = defQueries+      , pieChartUnit = Just ShortFormat+      , pieChartAliasColors = mempty+      , pieType = Donut+      }+  in+    assertEqJSON+      (toJSON (pieChartPanel pieChart defGridPos))+      (object+        [ "gridPos" .= defGridPosJSON+        , "title" .= String "name"+        , "type" .= String "grafana-piechart-panel"+        , "pieType" .= String "donut"+        , "aliasColors" .= Object mempty+        , "targets" .= defQueriesJSON+        , "format" .= String "short"+        ])++dashboardSerialize :: Assertion+dashboardSerialize =+  let+    pieChart = PieChart+      { pieChartTitle = "name"+      , pieChartQueries = defQueries+      , pieChartUnit = Just ShortFormat+      , pieChartAliasColors = mempty+      , pieType = Donut+      }+    testRow = Row "row name"+    panels =+      [pieChartPanel pieChart defGridPos, rowPanel testRow defGridPos]+    dashboard = defaultDashboard+      { dashboardPanels = panels+      , dashboardTime = TimeRange (Interval 6 Hours) Nothing+      }+  in+    assertEqJSON+      (toJSON dashboard)+      (object+        [ "panels" .= panels+        , "links" .= Array mempty+        , "tags" .= Array mempty+        , "title" .= String "New dashboard"+        , "time" .= object+            [ "to" .= String "now"+            , "from" .= String "now-6h"+            ]+        , "templating" .= object [ "list" .= Array mempty ]+        ])