{-# LANGUAGE ApplicativeDo, OverloadedStrings #-}

{-|
Module      : Client.Configuration.Macros
Description : Configuration schema for macros
Copyright   : (c) Eric Mertens, 2017
License     : ISC
Maintainer  : emertens@gmail.com

-}

module Client.Configuration.Macros
  ( macroMapSpec
  , macroCommandSpec
  ) where

import Client.Commands.Interpolation
import Client.Commands.Recognizer (fromCommands, Recognizer)
import Config.Schema.Spec
import Data.Maybe (fromMaybe)
import Data.Text (Text)

macroMapSpec :: ValueSpec (Recognizer Macro)
macroMapSpec :: ValueSpec (Recognizer Macro)
macroMapSpec = forall a. [(Text, a)] -> Recognizer a
fromCommands forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ValueSpec a -> ValueSpec [a]
listSpec ValueSpec (Text, Macro)
macroValueSpec

macroValueSpec :: ValueSpec (Text, Macro)
macroValueSpec :: ValueSpec (Text, Macro)
macroValueSpec = forall a. Text -> SectionsSpec a -> ValueSpec a
sectionsSpec Text
"macro" forall a b. (a -> b) -> a -> b
$
  do Text
name     <- forall a. HasSpec a => Text -> Text -> SectionsSpec a
reqSection Text
"name" Text
""
     MacroSpec
spec     <- forall a. a -> Maybe a -> a
fromMaybe MacroSpec
noMacroArguments
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Text -> ValueSpec a -> Text -> SectionsSpec (Maybe a)
optSection' Text
"arguments" ValueSpec MacroSpec
macroArgumentsSpec Text
""
     [[ExpansionChunk]]
commands <- forall a. Text -> ValueSpec a -> Text -> SectionsSpec a
reqSection' Text
"commands" (forall a. ValueSpec a -> ValueSpec [a]
oneOrList ValueSpec [ExpansionChunk]
macroCommandSpec) Text
""
     return (Text
name, Text -> MacroSpec -> [[ExpansionChunk]] -> Macro
Macro Text
name MacroSpec
spec [[ExpansionChunk]]
commands)

macroArgumentsSpec :: ValueSpec MacroSpec
macroArgumentsSpec :: ValueSpec MacroSpec
macroArgumentsSpec = forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"macro-arguments" forall a. HasSpec a => ValueSpec a
anySpec Text -> Either Text MacroSpec
parseMacroSpecs

macroCommandSpec :: ValueSpec [ExpansionChunk]
macroCommandSpec :: ValueSpec [ExpansionChunk]
macroCommandSpec = forall a b.
Text -> ValueSpec a -> (a -> Either Text b) -> ValueSpec b
customSpec Text
"macro-command" forall a. HasSpec a => ValueSpec a
anySpec Text -> Either Text [ExpansionChunk]
parseExpansion