{- | Generic data files: any YAML under @content/data/@, exposed to templates.

Each file becomes a template context named after its path (directories joined
with @-@, extension dropped). A file holding a top-level list is looped with
@$for(name)$@; a top-level map is read with @$name.key$@ (nested maps flatten
to dotted keys). Scalars render as strings.

A list item with @_show: false@ is left out of the loop entirely.

Any scalar field whose name contains @icon@ also gets two derived fields:
@<field>Href@ (the icon URL) and @<field>Raw@ (the SVG markup, inlined).
-}
module MathiasSM.Context.Data (
    dataContext,

    -- * Pure helpers (also used by the tests)
    renderScalar,
    scalarString,
    iconName,
    lookupLeaf,
    isShown,
    nameToRelPath,
    breakOnDot,
    iconVariant,
    IconVariant (..),
    checkAgainstSchema,
) where

import Control.Monad (when)
import Data.Aeson (Value (..))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KM
import Data.Foldable (toList)
import Data.JSON.JSONSchema (ValidationError (..), validate)
import Data.List (intercalate, isInfixOf, stripPrefix)
import Data.Maybe (fromMaybe)
import Data.Scientific (Scientific, floatingOrInteger)
import Data.String (fromString)
import Data.Text qualified as T
import Hakyll (
    Compiler,
    Context (..),
    ContextField (..),
    Identifier,
    Item (..),
    fromFilePath,
    getMatches,
    load,
    noResult,
    toFilePath,
 )
import MathiasSM.Config (SiteConfig, dataDir, mediaDir)
import MathiasSM.Yaml (decodeYaml)
import System.FilePath.Posix ((<.>), (</>))

-- | A dynamic context for every data file under 'dataDir'
dataContext :: SiteConfig -> Context a
dataContext :: forall a. SiteConfig -> Context a
dataContext SiteConfig
cfg = ([Char] -> [[Char]] -> Item a -> Compiler ContextField)
-> Context a
forall a.
([Char] -> [[Char]] -> Item a -> Compiler ContextField)
-> Context a
Context (([Char] -> [[Char]] -> Item a -> Compiler ContextField)
 -> Context a)
-> ([Char] -> [[Char]] -> Item a -> Compiler ContextField)
-> Context a
forall a b. (a -> b) -> a -> b
$ \[Char]
key [[Char]]
_ Item a
_ -> do
    let ([Char]
name, [Char]
fieldPath) = [Char] -> ([Char], [Char])
breakOnDot [Char]
key
        ident :: Identifier
ident = [Char] -> Identifier
fromFilePath ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ SiteConfig -> [Char]
dataDir SiteConfig
cfg [Char] -> [Char] -> [Char]
</> [Char] -> [Char]
nameToRelPath [Char]
name [Char] -> [Char] -> [Char]
<.> [Char]
"yaml"
    found <- Bool -> Bool
not (Bool -> Bool) -> ([Identifier] -> Bool) -> [Identifier] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Identifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Identifier] -> Bool) -> Compiler [Identifier] -> Compiler Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> Compiler [Identifier]
forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches ([Char] -> Pattern
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ Identifier -> [Char]
toFilePath Identifier
ident)
    if not found
        then noResult $ "Missing field '" ++ key ++ "' in context"
        else do
            body <- itemBody <$> load ident
            case decodeYaml body of
                Left [[Char]]
problems ->
                    [Char] -> Compiler ContextField
forall a. [Char] -> Compiler a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Compiler ContextField)
-> [Char] -> Compiler ContextField
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid data file " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Identifier -> [Char]
toFilePath Identifier
ident [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
problems
                Right Value
value -> do
                    SiteConfig -> [Char] -> Value -> Compiler ()
validateDataFile SiteConfig
cfg [Char]
name Value
value
                    SiteConfig
-> Identifier -> [Char] -> Value -> Compiler ContextField
buildTopLevel SiteConfig
cfg Identifier
ident [Char]
fieldPath Value
value

-- | Fails the build if the data file has a co-located @<name>.schema.json@ it violates
validateDataFile :: SiteConfig -> String -> Value -> Compiler ()
validateDataFile :: SiteConfig -> [Char] -> Value -> Compiler ()
validateDataFile SiteConfig
cfg [Char]
name Value
value = do
    let relPath :: [Char]
relPath = [Char] -> [Char]
nameToRelPath [Char]
name
        schemaIdent :: Identifier
schemaIdent = [Char] -> Identifier
fromFilePath ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ SiteConfig -> [Char]
dataDir SiteConfig
cfg [Char] -> [Char] -> [Char]
</> [Char]
relPath [Char] -> [Char] -> [Char]
<.> [Char]
"schema.json"
    hasSchema <- Bool -> Bool
not (Bool -> Bool) -> ([Identifier] -> Bool) -> [Identifier] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Identifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Identifier] -> Bool) -> Compiler [Identifier] -> Compiler Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> Compiler [Identifier]
forall (m :: * -> *). MonadMetadata m => Pattern -> m [Identifier]
getMatches ([Char] -> Pattern
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pattern) -> [Char] -> Pattern
forall a b. (a -> b) -> a -> b
$ Identifier -> [Char]
toFilePath Identifier
schemaIdent)
    when hasSchema $ do
        schemaBody <- itemBody <$> load schemaIdent
        case decodeYaml schemaBody of
            Left [[Char]]
problems ->
                [Char] -> Compiler ()
forall a. [Char] -> Compiler a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Compiler ()) -> [Char] -> Compiler ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid schema for data file '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"':\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
problems
            Right Value
schema ->
                case Value -> Value -> Either [[Char]] ()
checkAgainstSchema Value
schema Value
value of
                    Right () -> () -> Compiler ()
forall a. a -> Compiler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                    Left [[Char]]
errs ->
                        [Char] -> Compiler ()
forall a. [Char] -> Compiler a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Compiler ()) -> [Char] -> Compiler ()
forall a b. (a -> b) -> a -> b
$
                            [Char]
"Data file '"
                                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name
                                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"' failed schema validation:\n"
                                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [[Char]]
errs

-- | Validates @value@ against @schema@, returning the rendered violations
checkAgainstSchema :: Value -> Value -> Either [String] ()
checkAgainstSchema :: Value -> Value -> Either [[Char]] ()
checkAgainstSchema Value
schema Value
value =
    case Value -> Value -> Either [ValidationError] ()
validate Value
schema Value
value of
        Right () -> () -> Either [[Char]] ()
forall a b. b -> Either a b
Right ()
        Left [ValidationError]
errs -> [[Char]] -> Either [[Char]] ()
forall a b. a -> Either a b
Left ((ValidationError -> [Char]) -> [ValidationError] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ValidationError -> [Char]
renderValidationError [ValidationError]
errs)

-- | A schema validation error with its instance path
renderValidationError :: ValidationError -> String
renderValidationError :: ValidationError -> [Char]
renderValidationError (ValidationError [Text]
path Text
msg) =
    (if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
path then [Char]
"(root)" else [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack [Text]
path)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
msg

-- | The fields of one item in a list data file
itemContext :: SiteConfig -> Context Value
itemContext :: SiteConfig -> Context Value
itemContext SiteConfig
cfg = ([Char] -> [[Char]] -> Item Value -> Compiler ContextField)
-> Context Value
forall a.
([Char] -> [[Char]] -> Item a -> Compiler ContextField)
-> Context a
Context (([Char] -> [[Char]] -> Item Value -> Compiler ContextField)
 -> Context Value)
-> ([Char] -> [[Char]] -> Item Value -> Compiler ContextField)
-> Context Value
forall a b. (a -> b) -> a -> b
$ \[Char]
key [[Char]]
_ Item Value
item -> SiteConfig -> Value -> [Char] -> Compiler ContextField
valueField SiteConfig
cfg (Item Value -> Value
forall a. Item a -> a
itemBody Item Value
item) [Char]
key

-- | A top-level data value: a list loops as a field, a map is read by dotted key
buildTopLevel :: SiteConfig -> Identifier -> String -> Value -> Compiler ContextField
buildTopLevel :: SiteConfig
-> Identifier -> [Char] -> Value -> Compiler ContextField
buildTopLevel SiteConfig
cfg Identifier
ident [Char]
fieldPath Value
value = case Value
value of
    Array Array
items
        | [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
fieldPath ->
            ContextField -> Compiler ContextField
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContextField -> Compiler ContextField)
-> ([Item Value] -> ContextField)
-> [Item Value]
-> Compiler ContextField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context Value -> [Item Value] -> ContextField
forall a. Context a -> [Item a] -> ContextField
ListField (SiteConfig -> Context Value
itemContext SiteConfig
cfg) ([Item Value] -> Compiler ContextField)
-> [Item Value] -> Compiler ContextField
forall a b. (a -> b) -> a -> b
$
                [Identifier -> Value -> Item Value
forall a. Identifier -> a -> Item a
Item ([Char] -> Identifier
fromFilePath ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ Identifier -> [Char]
toFilePath Identifier
ident [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"#" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n) Value
item | (Int
n, Value
item) <- [Int] -> [Value] -> [(Int, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Value]
shown]
      where
        shown :: [Value]
shown = (Value -> Bool) -> [Value] -> [Value]
forall a. (a -> Bool) -> [a] -> [a]
filter Value -> Bool
isShown (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
items)
    Value
_ -> SiteConfig -> Value -> [Char] -> Compiler ContextField
valueField SiteConfig
cfg Value
value [Char]
fieldPath

-- | Whether a list item should appear: only an explicit @_show: false@ hides it
isShown :: Value -> Bool
isShown :: Value -> Bool
isShown (Object Object
object) = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup ([Char] -> Key
Key.fromString [Char]
"_show") Object
object Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value -> Maybe Value
forall a. a -> Maybe a
Just (Bool -> Value
Bool Bool
False)
isShown Value
_ = Bool
True

-- | Resolves one template key against a value: a scalar leaf, or a derived icon field
valueField :: SiteConfig -> Value -> String -> Compiler ContextField
valueField :: SiteConfig -> Value -> [Char] -> Compiler ContextField
valueField SiteConfig
cfg Value
value [Char]
key =
    case [Char] -> Value -> Maybe Value
lookupLeaf [Char]
key Value
value of
        Just Value
leaf -> Value -> Compiler ContextField
scalarField Value
leaf
        Maybe Value
Nothing -> case [Char] -> Maybe ([Char], IconVariant)
iconVariant [Char]
key of
            Just ([Char]
base, IconVariant
Href) -> Maybe Value -> Compiler ContextField
iconHref ([Char] -> Value -> Maybe Value
lookupLeaf [Char]
base Value
value)
            Just ([Char]
base, IconVariant
Raw) -> SiteConfig -> Maybe Value -> Compiler ContextField
iconRaw SiteConfig
cfg ([Char] -> Value -> Maybe Value
lookupLeaf [Char]
base Value
value)
            Maybe ([Char], IconVariant)
Nothing -> [Char] -> Compiler ContextField
forall a. [Char] -> Compiler a
noResult ([Char] -> Compiler ContextField)
-> [Char] -> Compiler ContextField
forall a b. (a -> b) -> a -> b
$ [Char]
"Field '" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
key [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"'"

-- | A scalar leaf as a string field (maps and lists cannot be rendered as a scalar)
scalarField :: Value -> Compiler ContextField
scalarField :: Value -> Compiler ContextField
scalarField = Compiler ContextField
-> ([Char] -> Compiler ContextField)
-> Maybe [Char]
-> Compiler ContextField
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Compiler ContextField
forall a. [Char] -> Compiler a
noResult [Char]
"not a scalar value") (ContextField -> Compiler ContextField
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContextField -> Compiler ContextField)
-> ([Char] -> ContextField) -> [Char] -> Compiler ContextField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ContextField
StringField) (Maybe [Char] -> Compiler ContextField)
-> (Value -> Maybe [Char]) -> Value -> Compiler ContextField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe [Char]
scalarString

-- | The text of a scalar value, if it is one
scalarString :: Value -> Maybe String
scalarString :: Value -> Maybe [Char]
scalarString = \case
    String Text
text -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
text
    Number Scientific
n -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Scientific -> [Char]
renderNumber Scientific
n
    Bool Bool
b -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ if Bool
b then [Char]
"true" else [Char]
"false"
    Value
Null -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
""
    Value
_ -> Maybe [Char]
forall a. Maybe a
Nothing

-- | The URL of an icon (a bare name under @images/icons/@, @.svg@ appended)
iconHref :: Maybe Value -> Compiler ContextField
iconHref :: Maybe Value -> Compiler ContextField
iconHref = Compiler ContextField
-> ([Char] -> Compiler ContextField)
-> Maybe [Char]
-> Compiler ContextField
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Compiler ContextField
forall a. [Char] -> Compiler a
noResult [Char]
"icon href") (ContextField -> Compiler ContextField
forall a. a -> Compiler a
forall (m :: * -> *) a. Monad m => a -> m a
return (ContextField -> Compiler ContextField)
-> ([Char] -> ContextField) -> [Char] -> Compiler ContextField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ContextField
StringField ([Char] -> ContextField)
-> ([Char] -> [Char]) -> [Char] -> ContextField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
iconPath) (Maybe [Char] -> Compiler ContextField)
-> (Maybe Value -> Maybe [Char])
-> Maybe Value
-> Compiler ContextField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> (Value -> Maybe [Char]) -> Maybe [Char]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe [Char]
iconName)
  where
    iconPath :: [Char] -> [Char]
iconPath [Char]
name = [Char]
"images/icons/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".svg"

-- | The SVG markup of an icon, inlined
iconRaw :: SiteConfig -> Maybe Value -> Compiler ContextField
iconRaw :: SiteConfig -> Maybe Value -> Compiler ContextField
iconRaw SiteConfig
cfg = Compiler ContextField
-> ([Char] -> Compiler ContextField)
-> Maybe [Char]
-> Compiler ContextField
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> Compiler ContextField
forall a. [Char] -> Compiler a
noResult [Char]
"icon raw") [Char] -> Compiler ContextField
loadSvg (Maybe [Char] -> Compiler ContextField)
-> (Maybe Value -> Maybe [Char])
-> Maybe Value
-> Compiler ContextField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Value -> (Value -> Maybe [Char]) -> Maybe [Char]
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe [Char]
iconName)
  where
    loadSvg :: [Char] -> Compiler ContextField
loadSvg [Char]
name = do
        body <- Item [Char] -> [Char]
forall a. Item a -> a
itemBody (Item [Char] -> [Char])
-> Compiler (Item [Char]) -> Compiler [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Identifier -> Compiler (Item [Char])
forall a. (Binary a, Typeable a) => Identifier -> Compiler (Item a)
load ([Char] -> Identifier
fromFilePath ([Char] -> Identifier) -> [Char] -> Identifier
forall a b. (a -> b) -> a -> b
$ SiteConfig -> [Char]
mediaDir SiteConfig
cfg [Char] -> [Char] -> [Char]
</> [Char]
"icons" [Char] -> [Char] -> [Char]
</> [Char]
name [Char] -> [Char] -> [Char]
<.> [Char]
"svg")
        return $ StringField body

-- | The bare name of an icon value, if it is a string
iconName :: Value -> Maybe String
iconName :: Value -> Maybe [Char]
iconName = \case
    String Text
name -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
name
    Value
_ -> Maybe [Char]
forall a. Maybe a
Nothing

-- | Whether a key names a derived icon field (@<base>Href@ / @<base>Raw@)
data IconVariant = Href | Raw
    deriving (IconVariant -> IconVariant -> Bool
(IconVariant -> IconVariant -> Bool)
-> (IconVariant -> IconVariant -> Bool) -> Eq IconVariant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IconVariant -> IconVariant -> Bool
== :: IconVariant -> IconVariant -> Bool
$c/= :: IconVariant -> IconVariant -> Bool
/= :: IconVariant -> IconVariant -> Bool
Eq, Int -> IconVariant -> [Char] -> [Char]
[IconVariant] -> [Char] -> [Char]
IconVariant -> [Char]
(Int -> IconVariant -> [Char] -> [Char])
-> (IconVariant -> [Char])
-> ([IconVariant] -> [Char] -> [Char])
-> Show IconVariant
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> IconVariant -> [Char] -> [Char]
showsPrec :: Int -> IconVariant -> [Char] -> [Char]
$cshow :: IconVariant -> [Char]
show :: IconVariant -> [Char]
$cshowList :: [IconVariant] -> [Char] -> [Char]
showList :: [IconVariant] -> [Char] -> [Char]
Show)

iconVariant :: String -> Maybe (String, IconVariant)
iconVariant :: [Char] -> Maybe ([Char], IconVariant)
iconVariant [Char]
key =
    case [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [Char]
"Href" [Char]
key of
        Just [Char]
base | [Char]
"icon" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
base -> ([Char], IconVariant) -> Maybe ([Char], IconVariant)
forall a. a -> Maybe a
Just ([Char]
base, IconVariant
Href)
        Maybe [Char]
_ -> case [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [Char]
"Raw" [Char]
key of
            Just [Char]
base | [Char]
"icon" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
base -> ([Char], IconVariant) -> Maybe ([Char], IconVariant)
forall a. a -> Maybe a
Just ([Char]
base, IconVariant
Raw)
            Maybe [Char]
_ -> Maybe ([Char], IconVariant)
forall a. Maybe a
Nothing

-- | The dotted path of a scalar leaf inside a value, if any
lookupLeaf :: String -> Value -> Maybe Value
lookupLeaf :: [Char] -> Value -> Maybe Value
lookupLeaf [Char]
path = [[Char]] -> Value -> Maybe Value
go ([Char] -> [[Char]]
splitOnDot [Char]
path)
  where
    go :: [[Char]] -> Value -> Maybe Value
go [] Value
value = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
value
    go ([Char]
part : [[Char]]
rest) (Object Object
object) = Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup ([Char] -> Key
Key.fromString [Char]
part) Object
object Maybe Value -> (Value -> Maybe Value) -> Maybe Value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [[Char]] -> Value -> Maybe Value
go [[Char]]
rest
    go [[Char]]
_ Value
_ = Maybe Value
forall a. Maybe a
Nothing

-- | The file name (directories joined with @-@) is a path relative to 'dataDir'
nameToRelPath :: String -> FilePath
nameToRelPath :: [Char] -> [Char]
nameToRelPath = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then Char
'/' else Char
c)

-- | The key up to the first dot, and the dotted path after it
breakOnDot :: String -> (String, String)
breakOnDot :: [Char] -> ([Char], [Char])
breakOnDot [Char]
key = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') [Char]
key of
    ([Char]
name, []) -> ([Char]
name, [Char]
"")
    ([Char]
name, Char
_ : [Char]
rest) -> ([Char]
name, [Char]
rest)

splitOnDot :: String -> [String]
splitOnDot :: [Char] -> [[Char]]
splitOnDot = [Char] -> [[Char]]
go
  where
    go :: [Char] -> [[Char]]
go [Char]
path = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') [Char]
path of
        ([Char]
part, []) -> [[Char]
part]
        ([Char]
part, Char
_ : [Char]
rest) -> [Char]
part [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
go [Char]
rest

-- | 'Data.List.stripSuffix', absent from the 'base' this project targets
stripSuffix :: (Eq a) => [a] -> [a] -> Maybe [a]
stripSuffix :: forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [a]
suffix [a]
list = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
suffix) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
list)

-- | A JSON number rendered without scientific notation
renderNumber :: Scientific -> String
renderNumber :: Scientific -> [Char]
renderNumber Scientific
n = case Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n of
    Right Integer
integer -> Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer
integer :: Integer)
    Left Double
double -> Double -> [Char]
forall a. Show a => a -> [Char]
show (Double
double :: Double)

-- | A scalar as the string templates should see
renderScalar :: Value -> String
renderScalar :: Value -> [Char]
renderScalar = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"" (Maybe [Char] -> [Char])
-> (Value -> Maybe [Char]) -> Value -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Maybe [Char]
scalarString