{-# 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