{-# LANGUAGE Safe, OverloadedStrings, DeriveTraversable, RankNTypes #-}
{-|
Module      : Config.Macro
Description : Configuration pre-processor adding support for aliases and common sections
Copyright   : (c) Eric Mertens, 2020
License     : ISC
Maintainer  : emertens@gmail.com

This module provides assigns meaning to atoms and section names that start with @\@@
and @$@. It provides processing pass for configuration to use local variables and
inclusion to better structure configuration.

= Sigils

* @$@ starts a variable.
* @\@@ starts a directive.

Merge key-value mappings using @\@splice@.

Load external configuration with @\@load@.

= Variables

Variables are atoms that start with a @$@ sigil. Variables are defined by
setting a variable as a section name. This variable will remain in
scope for the remainder of the sections being defined.

Variables used in a value position will be replaced with their previously
defined values.

@
$example: 42
field1: $example
field2: [0, $example]
@

expands to

@
field1: 42
field2: [0, 42]
@

Later variable definitions will shadow earlier definitions.

@
{ $x: 1, $x: 2, k: $x }
@

expands to

@
{ k: 2 }
@

Scoping examples:

@
top1:
  a:  $x                     -- BAD: $x not defined yet
  $x: 42                     -- $x is now defined to be 42
  b:  $x                     -- OK: $x was defined above
  c:  {sub1: $x, sub2: [$x]} -- OK: $x in scope in subsections
                             -- note: $x now goes out of scope
top2: $x                     -- BAD: $x no longer in scope
@

Macros are expanded at there definition site. All variables are resolved before
adding the new variable into the environment. Variables are lexically scoped
rather than dynamically scoped.

Allowed:

@
$x: 1
$y: $x -- OK, y is now 1
@

Not allowed:

@
$y: $x -- BAD: $x was not in scope
$x: 1
z:  $y
@

= Sections splicing

One sections value can be spliced into another sections value using the @\@spilce@
directive. It is an error to splice a value that is not a key-value sections.

@
$xy: { x: 0, y: 1 }
example:
  \@splice: $xy
  z: 2
@

expands to

@
example:
  x: 0
  y: 1
  z: 2
@

= File loading

The @\@load@ directive is intended including configuration from other sources.
'loadFileWithMacros' provides an interpretation of this directive that loads
other files. An arbitrary interpretation can be defined with 'expandMacros''

To load a value define a key-value mapping with a single @\@load@ key with a
value specifying the location to load from.

@
x: @load: "fourty-two.cfg"
@

could expand to

@
x: 42
@

-}
module Config.Macro (
  -- * Macro expansion primitives
  MacroError(..),
  expandMacros,
  expandMacros',

  -- * File loader with inclusion
  LoadFileError(..),
  FilePosition(..),
  loadFileWithMacros
  ) where

import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Control.Exception
import Config
import Data.Map (Map)
import Data.Typeable (Typeable)
import qualified Data.Map as Map

-- | Errors from macro expansion annotated with the 'valueAnn' from
-- the 'Value' nearest to the problem (typically a file position).
data MacroError a
  = UndeclaredVariable a Text -- ^ Variable used before its defintion
  | UnknownDirective a Text   -- ^ Unknown directive
  | BadSplice a               -- ^ Incorrect use of @\@splice@
  | BadLoad a                 -- ^ Incorrect use of @\@load@
  deriving
  (MacroError a -> MacroError a -> Bool
(MacroError a -> MacroError a -> Bool)
-> (MacroError a -> MacroError a -> Bool) -> Eq (MacroError a)
forall a. Eq a => MacroError a -> MacroError a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MacroError a -> MacroError a -> Bool
$c/= :: forall a. Eq a => MacroError a -> MacroError a -> Bool
== :: MacroError a -> MacroError a -> Bool
$c== :: forall a. Eq a => MacroError a -> MacroError a -> Bool
Eq, ReadPrec [MacroError a]
ReadPrec (MacroError a)
Int -> ReadS (MacroError a)
ReadS [MacroError a]
(Int -> ReadS (MacroError a))
-> ReadS [MacroError a]
-> ReadPrec (MacroError a)
-> ReadPrec [MacroError a]
-> Read (MacroError a)
forall a. Read a => ReadPrec [MacroError a]
forall a. Read a => ReadPrec (MacroError a)
forall a. Read a => Int -> ReadS (MacroError a)
forall a. Read a => ReadS [MacroError a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MacroError a]
$creadListPrec :: forall a. Read a => ReadPrec [MacroError a]
readPrec :: ReadPrec (MacroError a)
$creadPrec :: forall a. Read a => ReadPrec (MacroError a)
readList :: ReadS [MacroError a]
$creadList :: forall a. Read a => ReadS [MacroError a]
readsPrec :: Int -> ReadS (MacroError a)
$creadsPrec :: forall a. Read a => Int -> ReadS (MacroError a)
Read, Int -> MacroError a -> ShowS
[MacroError a] -> ShowS
MacroError a -> String
(Int -> MacroError a -> ShowS)
-> (MacroError a -> String)
-> ([MacroError a] -> ShowS)
-> Show (MacroError a)
forall a. Show a => Int -> MacroError a -> ShowS
forall a. Show a => [MacroError a] -> ShowS
forall a. Show a => MacroError a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MacroError a] -> ShowS
$cshowList :: forall a. Show a => [MacroError a] -> ShowS
show :: MacroError a -> String
$cshow :: forall a. Show a => MacroError a -> String
showsPrec :: Int -> MacroError a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MacroError a -> ShowS
Show, a -> MacroError b -> MacroError a
(a -> b) -> MacroError a -> MacroError b
(forall a b. (a -> b) -> MacroError a -> MacroError b)
-> (forall a b. a -> MacroError b -> MacroError a)
-> Functor MacroError
forall a b. a -> MacroError b -> MacroError a
forall a b. (a -> b) -> MacroError a -> MacroError b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> MacroError b -> MacroError a
$c<$ :: forall a b. a -> MacroError b -> MacroError a
fmap :: (a -> b) -> MacroError a -> MacroError b
$cfmap :: forall a b. (a -> b) -> MacroError a -> MacroError b
Functor, MacroError a -> Bool
(a -> m) -> MacroError a -> m
(a -> b -> b) -> b -> MacroError a -> b
(forall m. Monoid m => MacroError m -> m)
-> (forall m a. Monoid m => (a -> m) -> MacroError a -> m)
-> (forall m a. Monoid m => (a -> m) -> MacroError a -> m)
-> (forall a b. (a -> b -> b) -> b -> MacroError a -> b)
-> (forall a b. (a -> b -> b) -> b -> MacroError a -> b)
-> (forall b a. (b -> a -> b) -> b -> MacroError a -> b)
-> (forall b a. (b -> a -> b) -> b -> MacroError a -> b)
-> (forall a. (a -> a -> a) -> MacroError a -> a)
-> (forall a. (a -> a -> a) -> MacroError a -> a)
-> (forall a. MacroError a -> [a])
-> (forall a. MacroError a -> Bool)
-> (forall a. MacroError a -> Int)
-> (forall a. Eq a => a -> MacroError a -> Bool)
-> (forall a. Ord a => MacroError a -> a)
-> (forall a. Ord a => MacroError a -> a)
-> (forall a. Num a => MacroError a -> a)
-> (forall a. Num a => MacroError a -> a)
-> Foldable MacroError
forall a. Eq a => a -> MacroError a -> Bool
forall a. Num a => MacroError a -> a
forall a. Ord a => MacroError a -> a
forall m. Monoid m => MacroError m -> m
forall a. MacroError a -> Bool
forall a. MacroError a -> Int
forall a. MacroError a -> [a]
forall a. (a -> a -> a) -> MacroError a -> a
forall m a. Monoid m => (a -> m) -> MacroError a -> m
forall b a. (b -> a -> b) -> b -> MacroError a -> b
forall a b. (a -> b -> b) -> b -> MacroError a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: MacroError a -> a
$cproduct :: forall a. Num a => MacroError a -> a
sum :: MacroError a -> a
$csum :: forall a. Num a => MacroError a -> a
minimum :: MacroError a -> a
$cminimum :: forall a. Ord a => MacroError a -> a
maximum :: MacroError a -> a
$cmaximum :: forall a. Ord a => MacroError a -> a
elem :: a -> MacroError a -> Bool
$celem :: forall a. Eq a => a -> MacroError a -> Bool
length :: MacroError a -> Int
$clength :: forall a. MacroError a -> Int
null :: MacroError a -> Bool
$cnull :: forall a. MacroError a -> Bool
toList :: MacroError a -> [a]
$ctoList :: forall a. MacroError a -> [a]
foldl1 :: (a -> a -> a) -> MacroError a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MacroError a -> a
foldr1 :: (a -> a -> a) -> MacroError a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MacroError a -> a
foldl' :: (b -> a -> b) -> b -> MacroError a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MacroError a -> b
foldl :: (b -> a -> b) -> b -> MacroError a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MacroError a -> b
foldr' :: (a -> b -> b) -> b -> MacroError a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MacroError a -> b
foldr :: (a -> b -> b) -> b -> MacroError a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MacroError a -> b
foldMap' :: (a -> m) -> MacroError a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MacroError a -> m
foldMap :: (a -> m) -> MacroError a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MacroError a -> m
fold :: MacroError m -> m
$cfold :: forall m. Monoid m => MacroError m -> m
Foldable, Functor MacroError
Foldable MacroError
Functor MacroError
-> Foldable MacroError
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> MacroError a -> f (MacroError b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    MacroError (f a) -> f (MacroError a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> MacroError a -> m (MacroError b))
-> (forall (m :: * -> *) a.
    Monad m =>
    MacroError (m a) -> m (MacroError a))
-> Traversable MacroError
(a -> f b) -> MacroError a -> f (MacroError b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MacroError (m a) -> m (MacroError a)
forall (f :: * -> *) a.
Applicative f =>
MacroError (f a) -> f (MacroError a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MacroError a -> m (MacroError b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MacroError a -> f (MacroError b)
sequence :: MacroError (m a) -> m (MacroError a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MacroError (m a) -> m (MacroError a)
mapM :: (a -> m b) -> MacroError a -> m (MacroError b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MacroError a -> m (MacroError b)
sequenceA :: MacroError (f a) -> f (MacroError a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MacroError (f a) -> f (MacroError a)
traverse :: (a -> f b) -> MacroError a -> f (MacroError b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MacroError a -> f (MacroError b)
$cp2Traversable :: Foldable MacroError
$cp1Traversable :: Functor MacroError
Traversable)

instance (Typeable a, Show a) => Exception (MacroError a)

data Special = Plain | Variable Text | Splice | Load

processAtom :: a -> Text -> Either (MacroError a) Special
processAtom :: a -> Text -> Either (MacroError a) Special
processAtom a
a Text
txt =
  case Text -> Maybe (Char, Text)
Text.uncons Text
txt of
    Just (Char
'@',Text
"splice") -> Special -> Either (MacroError a) Special
forall a b. b -> Either a b
Right Special
Splice
    Just (Char
'@',Text
"load"  ) -> Special -> Either (MacroError a) Special
forall a b. b -> Either a b
Right Special
Load
    Just (Char
'@',Text
t       ) -> MacroError a -> Either (MacroError a) Special
forall a b. a -> Either a b
Left (a -> Text -> MacroError a
forall a. a -> Text -> MacroError a
UnknownDirective a
a Text
t)
    Just (Char
'$',Text
t       ) -> Special -> Either (MacroError a) Special
forall a b. b -> Either a b
Right (Text -> Special
Variable Text
t)
    Maybe (Char, Text)
_                   -> Special -> Either (MacroError a) Special
forall a b. b -> Either a b
Right Special
Plain

-- | Expand macros in a configuration value.
--
-- @\@load@ not supported and results in a 'BadLoad' error.
expandMacros :: Value a -> Either (MacroError a) (Value a)
expandMacros :: Value a -> Either (MacroError a) (Value a)
expandMacros = (forall b. MacroError a -> Either (MacroError a) b)
-> (Value a -> Either (MacroError a) (Value a))
-> Map Text (Value a)
-> Value a
-> Either (MacroError a) (Value a)
forall (m :: * -> *) a.
Monad m =>
(forall b. MacroError a -> m b)
-> (Value a -> m (Value a))
-> Map Text (Value a)
-> Value a
-> m (Value a)
expandMacros' forall b. MacroError a -> Either (MacroError a) b
forall a b. a -> Either a b
Left (MacroError a -> Either (MacroError a) (Value a)
forall a b. a -> Either a b
Left (MacroError a -> Either (MacroError a) (Value a))
-> (Value a -> MacroError a)
-> Value a
-> Either (MacroError a) (Value a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MacroError a
forall a. a -> MacroError a
BadLoad (a -> MacroError a) -> (Value a -> a) -> Value a -> MacroError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> a
forall a. Value a -> a
valueAnn) Map Text (Value a)
forall k a. Map k a
Map.empty

-- | Expand macros in a configuration value using a pre-populated environment.
expandMacros' ::
  Monad m =>
  (forall b. MacroError a -> m b) {- ^ failure                       -} ->
  (Value a -> m (Value a))        {- ^ @\@load@ implementation       -} ->
  Map Text (Value a)              {- ^ variable environment          -} ->
  Value a                         {- ^ value to expand               -} ->
  m (Value a)                     {- ^ expanded value                -}
expandMacros' :: (forall b. MacroError a -> m b)
-> (Value a -> m (Value a))
-> Map Text (Value a)
-> Value a
-> m (Value a)
expandMacros' forall b. MacroError a -> m b
failure Value a -> m (Value a)
load = Map Text (Value a) -> Value a -> m (Value a)
go
  where
    proc :: a -> Text -> m Special
proc a
a Text
txt = (MacroError a -> m Special)
-> (Special -> m Special)
-> Either (MacroError a) Special
-> m Special
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MacroError a -> m Special
forall b. MacroError a -> m b
failure Special -> m Special
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Text -> Either (MacroError a) Special
forall a. a -> Text -> Either (MacroError a) Special
processAtom a
a Text
txt)

    go :: Map Text (Value a) -> Value a -> m (Value a)
go Map Text (Value a)
env Value a
v =
      case Value a
v of
        Number a
a Number
x -> Value a -> m (Value a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Number -> Value a
forall a. a -> Number -> Value a
Number a
a Number
x)
        Text a
a Text
x -> Value a -> m (Value a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Text -> Value a
forall a. a -> Text -> Value a
Text a
a Text
x)
        List a
a [Value a]
x -> a -> [Value a] -> Value a
forall a. a -> [Value a] -> Value a
List a
a ([Value a] -> Value a) -> m [Value a] -> m (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value a -> m (Value a)) -> [Value a] -> m [Value a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Map Text (Value a) -> Value a -> m (Value a)
go Map Text (Value a)
env) [Value a]
x

        Sections a
_ [Section a
_ Text
"@load" Value a
arg] -> Value a -> m (Value a)
load (Value a -> m (Value a)) -> m (Value a) -> m (Value a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Map Text (Value a) -> Value a -> m (Value a)
go Map Text (Value a)
env Value a
arg
        Sections a
a [Section a]
x -> a -> [Section a] -> Value a
forall a. a -> [Section a] -> Value a
Sections a
a ([Section a] -> Value a) -> m [Section a] -> m (Value a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Value a) -> [Section a] -> m [Section a]
elaborateSections Map Text (Value a)
env [Section a]
x

        Atom a
a Atom
x ->
          do Special
x' <- a -> Text -> m Special
proc a
a (Atom -> Text
atomName Atom
x)
             case Special
x' of
               Special
Plain -> Value a -> m (Value a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Atom -> Value a
forall a. a -> Atom -> Value a
Atom a
a Atom
x)
               Special
Splice -> MacroError a -> m (Value a)
forall b. MacroError a -> m b
failure (a -> MacroError a
forall a. a -> MacroError a
BadSplice a
a)
               Special
Load -> MacroError a -> m (Value a)
forall b. MacroError a -> m b
failure (a -> MacroError a
forall a. a -> MacroError a
BadLoad a
a)
               Variable Text
var ->
                 case Text -> Map Text (Value a) -> Maybe (Value a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
var Map Text (Value a)
env of
                   Maybe (Value a)
Nothing -> MacroError a -> m (Value a)
forall b. MacroError a -> m b
failure (a -> Text -> MacroError a
forall a. a -> Text -> MacroError a
UndeclaredVariable a
a Text
var)
                   Just Value a
y -> Value a -> m (Value a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value a
y

    elaborateSections :: Map Text (Value a) -> [Section a] -> m [Section a]
elaborateSections Map Text (Value a)
_ [] = [Section a] -> m [Section a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    elaborateSections Map Text (Value a)
env (Section a
a Text
k Value a
v : [Section a]
xs) =
      do Special
special <- a -> Text -> m Special
proc a
a Text
k
         Value a
v' <- Map Text (Value a) -> Value a -> m (Value a)
go Map Text (Value a)
env Value a
v
         case Special
special of
           Special
Load -> MacroError a -> m [Section a]
forall b. MacroError a -> m b
failure (a -> MacroError a
forall a. a -> MacroError a
BadLoad a
a)
           Variable Text
var -> Map Text (Value a) -> [Section a] -> m [Section a]
elaborateSections (Text -> Value a -> Map Text (Value a) -> Map Text (Value a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
var Value a
v' Map Text (Value a)
env) [Section a]
xs
           Special
Plain -> (a -> Text -> Value a -> Section a
forall a. a -> Text -> Value a -> Section a
Section a
a Text
k Value a
v' Section a -> [Section a] -> [Section a]
forall a. a -> [a] -> [a]
:) ([Section a] -> [Section a]) -> m [Section a] -> m [Section a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Value a) -> [Section a] -> m [Section a]
elaborateSections Map Text (Value a)
env [Section a]
xs
           Special
Splice ->
             case Value a
v' of
               Sections a
_ [Section a]
ys -> ([Section a]
ys[Section a] -> [Section a] -> [Section a]
forall a. [a] -> [a] -> [a]
++) ([Section a] -> [Section a]) -> m [Section a] -> m [Section a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (Value a) -> [Section a] -> m [Section a]
elaborateSections Map Text (Value a)
env [Section a]
xs
               Value a
_ -> MacroError a -> m [Section a]
forall b. MacroError a -> m b
failure (a -> MacroError a
forall a. a -> MacroError a
BadSplice a
a)

-- | A pair of filepath and position
data FilePosition = FilePosition FilePath Position
  deriving (ReadPrec [FilePosition]
ReadPrec FilePosition
Int -> ReadS FilePosition
ReadS [FilePosition]
(Int -> ReadS FilePosition)
-> ReadS [FilePosition]
-> ReadPrec FilePosition
-> ReadPrec [FilePosition]
-> Read FilePosition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FilePosition]
$creadListPrec :: ReadPrec [FilePosition]
readPrec :: ReadPrec FilePosition
$creadPrec :: ReadPrec FilePosition
readList :: ReadS [FilePosition]
$creadList :: ReadS [FilePosition]
readsPrec :: Int -> ReadS FilePosition
$creadsPrec :: Int -> ReadS FilePosition
Read, Int -> FilePosition -> ShowS
[FilePosition] -> ShowS
FilePosition -> String
(Int -> FilePosition -> ShowS)
-> (FilePosition -> String)
-> ([FilePosition] -> ShowS)
-> Show FilePosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilePosition] -> ShowS
$cshowList :: [FilePosition] -> ShowS
show :: FilePosition -> String
$cshow :: FilePosition -> String
showsPrec :: Int -> FilePosition -> ShowS
$cshowsPrec :: Int -> FilePosition -> ShowS
Show, Eq FilePosition
Eq FilePosition
-> (FilePosition -> FilePosition -> Ordering)
-> (FilePosition -> FilePosition -> Bool)
-> (FilePosition -> FilePosition -> Bool)
-> (FilePosition -> FilePosition -> Bool)
-> (FilePosition -> FilePosition -> Bool)
-> (FilePosition -> FilePosition -> FilePosition)
-> (FilePosition -> FilePosition -> FilePosition)
-> Ord FilePosition
FilePosition -> FilePosition -> Bool
FilePosition -> FilePosition -> Ordering
FilePosition -> FilePosition -> FilePosition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FilePosition -> FilePosition -> FilePosition
$cmin :: FilePosition -> FilePosition -> FilePosition
max :: FilePosition -> FilePosition -> FilePosition
$cmax :: FilePosition -> FilePosition -> FilePosition
>= :: FilePosition -> FilePosition -> Bool
$c>= :: FilePosition -> FilePosition -> Bool
> :: FilePosition -> FilePosition -> Bool
$c> :: FilePosition -> FilePosition -> Bool
<= :: FilePosition -> FilePosition -> Bool
$c<= :: FilePosition -> FilePosition -> Bool
< :: FilePosition -> FilePosition -> Bool
$c< :: FilePosition -> FilePosition -> Bool
compare :: FilePosition -> FilePosition -> Ordering
$ccompare :: FilePosition -> FilePosition -> Ordering
$cp1Ord :: Eq FilePosition
Ord, FilePosition -> FilePosition -> Bool
(FilePosition -> FilePosition -> Bool)
-> (FilePosition -> FilePosition -> Bool) -> Eq FilePosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilePosition -> FilePosition -> Bool
$c/= :: FilePosition -> FilePosition -> Bool
== :: FilePosition -> FilePosition -> Bool
$c== :: FilePosition -> FilePosition -> Bool
Eq)

-- | Errors thrown by 'loadFileWithMacros'
data LoadFileError
  = LoadFileParseError FilePath ParseError -- ^ failure to parse a file
  | LoadFileMacroError (MacroError FilePosition) -- ^ failure to expand macros
  deriving (LoadFileError -> LoadFileError -> Bool
(LoadFileError -> LoadFileError -> Bool)
-> (LoadFileError -> LoadFileError -> Bool) -> Eq LoadFileError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoadFileError -> LoadFileError -> Bool
$c/= :: LoadFileError -> LoadFileError -> Bool
== :: LoadFileError -> LoadFileError -> Bool
$c== :: LoadFileError -> LoadFileError -> Bool
Eq, ReadPrec [LoadFileError]
ReadPrec LoadFileError
Int -> ReadS LoadFileError
ReadS [LoadFileError]
(Int -> ReadS LoadFileError)
-> ReadS [LoadFileError]
-> ReadPrec LoadFileError
-> ReadPrec [LoadFileError]
-> Read LoadFileError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LoadFileError]
$creadListPrec :: ReadPrec [LoadFileError]
readPrec :: ReadPrec LoadFileError
$creadPrec :: ReadPrec LoadFileError
readList :: ReadS [LoadFileError]
$creadList :: ReadS [LoadFileError]
readsPrec :: Int -> ReadS LoadFileError
$creadsPrec :: Int -> ReadS LoadFileError
Read, Int -> LoadFileError -> ShowS
[LoadFileError] -> ShowS
LoadFileError -> String
(Int -> LoadFileError -> ShowS)
-> (LoadFileError -> String)
-> ([LoadFileError] -> ShowS)
-> Show LoadFileError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoadFileError] -> ShowS
$cshowList :: [LoadFileError] -> ShowS
show :: LoadFileError -> String
$cshow :: LoadFileError -> String
showsPrec :: Int -> LoadFileError -> ShowS
$cshowsPrec :: Int -> LoadFileError -> ShowS
Show)

instance Exception LoadFileError

-- | Load a configuration value from a given file path.
--
-- @\@load@ will compute included file path from the given function given the
-- load argument and current configuration file path.
--
-- Valid @\@load@ arguments are string literals use as arguments to
-- the path resolution function.
--
-- Throws `IOError` from file loads and `LoadFileError`
loadFileWithMacros ::
  (Text -> FilePath -> IO FilePath) {- ^ inclusion path resolution -} ->
  FilePath                          {- ^ starting file path -} ->
  IO (Value FilePosition)           {- ^ macro-expanded config value -}
loadFileWithMacros :: (Text -> String -> IO String) -> String -> IO (Value FilePosition)
loadFileWithMacros Text -> String -> IO String
findPath = String -> IO (Value FilePosition)
go
  where
    go :: String -> IO (Value FilePosition)
go String
path =
      do Text
txt <- String -> IO Text
Text.readFile String
path
         Value Position
v1 <- case Text -> Either ParseError (Value Position)
parse Text
txt of
                 Left ParseError
e -> LoadFileError -> IO (Value Position)
forall e a. Exception e => e -> IO a
throwIO (String -> ParseError -> LoadFileError
LoadFileParseError String
path ParseError
e)
                 Right Value Position
v -> Value Position -> IO (Value Position)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value Position
v
         let v2 :: Value FilePosition
v2 = String -> Position -> FilePosition
FilePosition String
path (Position -> FilePosition) -> Value Position -> Value FilePosition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value Position
v1
         let loadImpl :: Value FilePosition -> IO (Value FilePosition)
loadImpl Value FilePosition
pathVal =
               case Value FilePosition
pathVal of
                 Text FilePosition
_ Text
str -> String -> IO (Value FilePosition)
go (String -> IO (Value FilePosition))
-> IO String -> IO (Value FilePosition)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> String -> IO String
findPath Text
str String
path
                 Value FilePosition
_ -> LoadFileError -> IO (Value FilePosition)
forall e a. Exception e => e -> IO a
throwIO (MacroError FilePosition -> LoadFileError
LoadFileMacroError (FilePosition -> MacroError FilePosition
forall a. a -> MacroError a
BadLoad (Value FilePosition -> FilePosition
forall a. Value a -> a
valueAnn Value FilePosition
pathVal)))
         (forall b. MacroError FilePosition -> IO b)
-> (Value FilePosition -> IO (Value FilePosition))
-> Map Text (Value FilePosition)
-> Value FilePosition
-> IO (Value FilePosition)
forall (m :: * -> *) a.
Monad m =>
(forall b. MacroError a -> m b)
-> (Value a -> m (Value a))
-> Map Text (Value a)
-> Value a
-> m (Value a)
expandMacros' (LoadFileError -> IO b
forall e a. Exception e => e -> IO a
throwIO (LoadFileError -> IO b)
-> (MacroError FilePosition -> LoadFileError)
-> MacroError FilePosition
-> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MacroError FilePosition -> LoadFileError
LoadFileMacroError) Value FilePosition -> IO (Value FilePosition)
loadImpl Map Text (Value FilePosition)
forall k a. Map k a
Map.empty Value FilePosition
v2