{-|

Helper functions for defining valid JSON instances

-}

module Graphics.Plotly.Utils where

import Data.List (stripPrefix)
import Data.Aeson.Types

unLens :: String -> String
unLens :: String -> String
unLens (Char
'_':String
s) = String
s
unLens String
s = String
s

dropInitial :: String -> String -> String
dropInitial :: String -> String -> String
dropInitial String
s String
s' = case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
s String
s' of
                  Maybe String
Nothing -> String
s'
                  Just String
s'' -> String
s''

rename :: String -> String -> String -> String
rename :: String -> String -> String -> String
rename String
froms String
tos String
s | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
froms = String
tos
                   | Bool
otherwise = String
s

jsonOptions :: Options
jsonOptions :: Options
jsonOptions = Options
defaultOptions {omitNothingFields :: Bool
omitNothingFields = Bool
True,
                              fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
unLens }