{-# LANGUAGE DeriveFunctor #-}

-- | This is a utility module that consolidates all `Context`-related operations

module Dhall.Context (
    -- * Context
      Context
    , empty
    , insert
    , match
    , lookup
    , toList
    ) where

import Data.Text (Text)
import Prelude   hiding (lookup)

{-| A @(Context a)@ associates `Data.Text.Text` labels with values of type @a@.
    Each `Data.Text.Text` label can correspond to multiple values of type @a@

    The `Context` is used for type-checking when @(a = Expr X)@

    * You create a `Context` using `empty` and `insert`
    * You transform a `Context` using `fmap`
    * You consume a `Context` using `lookup` and `toList`

    The difference between a `Context` and a `Data.Map.Map` is that a `Context`
    lets you have multiple ordered occurrences of the same key and you can
    query for the @n@th occurrence of a given key.
-}
newtype Context a = Context { Context a -> [(Text, a)]
getContext :: [(Text, a)] }
    deriving (a -> Context b -> Context a
(a -> b) -> Context a -> Context b
(forall a b. (a -> b) -> Context a -> Context b)
-> (forall a b. a -> Context b -> Context a) -> Functor Context
forall a b. a -> Context b -> Context a
forall a b. (a -> b) -> Context a -> Context b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Context b -> Context a
$c<$ :: forall a b. a -> Context b -> Context a
fmap :: (a -> b) -> Context a -> Context b
$cfmap :: forall a b. (a -> b) -> Context a -> Context b
Functor)

-- | An empty context with no key-value pairs
empty :: Context a
empty :: Context a
empty = [(Text, a)] -> Context a
forall a. [(Text, a)] -> Context a
Context []

-- | Add a key-value pair to the `Context`
insert :: Text -> a -> Context a -> Context a
insert :: Text -> a -> Context a -> Context a
insert Text
k a
v (Context [(Text, a)]
kvs) = [(Text, a)] -> Context a
forall a. [(Text, a)] -> Context a
Context ((Text
k, a
v) (Text, a) -> [(Text, a)] -> [(Text, a)]
forall a. a -> [a] -> [a]
: [(Text, a)]
kvs)
{-# INLINABLE insert #-}

{-| \"Pattern match\" on a `Context`

> match (insert k v ctx) = Just (k, v, ctx)
> match  empty           = Nothing
-}
match :: Context a -> Maybe (Text, a, Context a)
match :: Context a -> Maybe (Text, a, Context a)
match (Context ((Text
k, a
v) : [(Text, a)]
kvs)) = (Text, a, Context a) -> Maybe (Text, a, Context a)
forall a. a -> Maybe a
Just (Text
k, a
v, [(Text, a)] -> Context a
forall a. [(Text, a)] -> Context a
Context [(Text, a)]
kvs)
match (Context           []  ) = Maybe (Text, a, Context a)
forall a. Maybe a
Nothing
{-# INLINABLE match #-}

{-| Look up a key by name and index

> lookup _ _         empty  = Nothing
> lookup k 0 (insert k v c) = Just v
> lookup k n (insert k v c) = lookup k (n - 1) c
> lookup k n (insert j v c) = lookup k  n      c  -- k /= j
-}
lookup :: Text -> Int -> Context a -> Maybe a
lookup :: Text -> Int -> Context a -> Maybe a
lookup Text
_ Int
_ (Context         []  ) =
    Maybe a
forall a. Maybe a
Nothing
lookup Text
x Int
n (Context ((Text
k, a
v):[(Text, a)]
kvs)) =
    if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k
    then if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
         then a -> Maybe a
forall a. a -> Maybe a
Just a
v
         else Text -> Int -> Context a -> Maybe a
forall a. Text -> Int -> Context a -> Maybe a
lookup Text
x (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ([(Text, a)] -> Context a
forall a. [(Text, a)] -> Context a
Context [(Text, a)]
kvs)
    else Text -> Int -> Context a -> Maybe a
forall a. Text -> Int -> Context a -> Maybe a
lookup Text
x Int
n ([(Text, a)] -> Context a
forall a. [(Text, a)] -> Context a
Context [(Text, a)]
kvs)
{-# INLINABLE lookup #-}

{-| Return all key-value associations as a list

> toList           empty  = []
> toList (insert k v ctx) = (k, v) : toList ctx
-}
toList :: Context a -> [(Text, a)]
toList :: Context a -> [(Text, a)]
toList = Context a -> [(Text, a)]
forall a. Context a -> [(Text, a)]
getContext
{-# INLINABLE toList #-}