{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}

-- |
module Language.Jsonnet.Check where

import Control.Monad.Except
import Data.Fix
import Data.Functor.Identity
import Data.List
import qualified Data.List.NonEmpty as NE
import Language.Jsonnet.Annotate
import Language.Jsonnet.Common hiding (span)
import Language.Jsonnet.Core
import Language.Jsonnet.Error
import Language.Jsonnet.Parser.SrcSpan
import Language.Jsonnet.Syntax
import Unbound.Generics.LocallyNameless

type Check = ExceptT Error IO

check :: Ann ExprF SrcSpan -> Check ()
check :: Ann ExprF SrcSpan -> Check ()
check = (Product (Const SrcSpan) ExprF () -> Check ())
-> Ann ExprF SrcSpan -> Check ()
forall (m :: * -> *) (t :: * -> *) a.
(Monad m, Traversable t) =>
(t a -> m a) -> Fix t -> m a
foldFixM Product (Const SrcSpan) ExprF () -> Check ()
forall {m :: * -> *} {a}.
Monad m =>
Product (Const SrcSpan) ExprF a -> ExceptT Error m ()
alg
  where
    alg :: Product (Const SrcSpan) ExprF a -> ExceptT Error m ()
alg (AnnF ExprF a
f SrcSpan
a) = (CheckError -> Error)
-> ExceptT CheckError m () -> ExceptT Error m ()
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (CheckError -> Maybe SrcSpan -> Error
`CheckError` (SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
a)) (ExceptT CheckError m () -> ExceptT Error m ())
-> ExceptT CheckError m () -> ExceptT Error m ()
forall a b. (a -> b) -> a -> b
$ case ExprF a
f of
      ELocal NonEmpty (Ident, a)
bnds a
_ -> [Ident] -> ExceptT CheckError m ()
forall {f :: * -> *}. MonadError CheckError f => [Ident] -> f ()
checkLocal (NonEmpty Ident -> [Ident]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Ident -> [Ident]) -> NonEmpty Ident -> [Ident]
forall a b. (a -> b) -> a -> b
$ (Ident, a) -> Ident
forall a b. (a, b) -> a
fst ((Ident, a) -> Ident) -> NonEmpty (Ident, a) -> NonEmpty Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Ident, a)
bnds)
      EFun [Param a]
ps a
_ -> [Ident] -> ExceptT CheckError m ()
forall {f :: * -> *}. MonadError CheckError f => [Ident] -> f ()
checkFun (Param a -> Ident
forall a b. (a, b) -> a
fst (Param a -> Ident) -> [Param a] -> [Ident]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Param a]
ps)
      EApply a
_ (Args [Arg a]
as Strictness
_) -> [Arg a] -> ExceptT CheckError m ()
forall {f :: * -> *} {a}.
MonadError CheckError f =>
[Arg a] -> f ()
checkApply [Arg a]
as
      ExprF a
_ -> () -> ExceptT CheckError m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    checkLocal :: [Ident] -> f ()
checkLocal [Ident]
names = case [Ident] -> [[Ident]]
dups [Ident]
names of
      [] -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ([Ident]
xs : [[Ident]]
_) -> CheckError -> f ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CheckError -> f ()) -> CheckError -> f ()
forall a b. (a -> b) -> a -> b
$ Ident -> CheckError
DuplicateBinding ([Ident] -> Ident
forall a. [a] -> a
head [Ident]
xs)
    checkFun :: [Ident] -> f ()
checkFun [Ident]
names = case [Ident] -> [[Ident]]
dups [Ident]
names of
      [] -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ([Ident]
xs : [[Ident]]
_) -> CheckError -> f ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CheckError -> f ()) -> CheckError -> f ()
forall a b. (a -> b) -> a -> b
$ Ident -> CheckError
DuplicateParam ([Ident] -> Ident
forall a. [a] -> a
head [Ident]
xs)
    checkApply :: [Arg a] -> f ()
checkApply [Arg a]
args = case [Arg a] -> [Arg a]
forall {p}. p -> [Arg a]
f [Arg a]
args of
      [] -> () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (Arg a
x : [Arg a]
_) -> CheckError -> f ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CheckError -> f ()) -> CheckError -> f ()
forall a b. (a -> b) -> a -> b
$ CheckError
PosAfterNamedParam
      where
        f :: p -> [Arg a]
f p
args = (Arg a -> Bool) -> [Arg a] -> [Arg a]
forall a. (a -> Bool) -> [a] -> [a]
filter Arg a -> Bool
forall {a}. Arg a -> Bool
isPos [Arg a]
ns
        isPos :: Arg a -> Bool
isPos = \case
          Pos a
_ -> Bool
True
          Arg a
_ -> Bool
False
        ([Arg a]
ps, [Arg a]
ns) = (Arg a -> Bool) -> [Arg a] -> ([Arg a], [Arg a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Arg a -> Bool
forall {a}. Arg a -> Bool
isPos [Arg a]
args
    dups :: [Ident] -> [[Ident]]
dups = ([Ident] -> Bool) -> [[Ident]] -> [[Ident]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ([Ident] -> Int) -> [Ident] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Ident]] -> [[Ident]])
-> ([Ident] -> [[Ident]]) -> [Ident] -> [[Ident]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> [[Ident]]
forall a. Eq a => [a] -> [[a]]
group ([Ident] -> [[Ident]])
-> ([Ident] -> [Ident]) -> [Ident] -> [[Ident]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Ident] -> [Ident]
forall a. Ord a => [a] -> [a]
sort