module SMCDEL.Internal.Sanity where

import SMCDEL.Internal.Parse
import SMCDEL.Language

-- | Sanity checks that are used by both the CLI and the Web interface.
sanityCheck :: CheckInput -> [String]
sanityCheck :: CheckInput -> [String]
sanityCheck (CheckInput [Int]
vocabInts Form
lawform [(String, [Int])]
obsSpec JobList
jobs) =
  let
    agents :: [String]
agents = ((String, [Int]) -> String) -> [(String, [Int])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, [Int]) -> String
forall a b. (a, b) -> a
fst [(String, [Int])]
obsSpec
    vocab :: [Prp]
vocab = (Int -> Prp) -> [Int] -> [Prp]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Prp
P [Int]
vocabInts
    jobForms :: [Form]
jobForms = [ Form
f | (TrueQ [Int]
_ Form
f) <- JobList
jobs ] [Form] -> [Form] -> [Form]
forall a. [a] -> [a] -> [a]
++ [ Form
f | (ValidQ Form
f) <- JobList
jobs ] [Form] -> [Form] -> [Form]
forall a. [a] -> [a] -> [a]
++ [ Form
f | (WhereQ Form
f) <- JobList
jobs ]
    jobAtoms :: [Int]
jobAtoms = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Int]
ps | (TrueQ [Int]
ps Form
_) <- JobList
jobs ]
  in
    [ String
"OBS contains atoms not in VARS!" | Bool -> Bool
not (((String, [Int]) -> Bool) -> [(String, [Int])] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
vocabInts) ([Int] -> Bool)
-> ((String, [Int]) -> [Int]) -> (String, [Int]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [Int]) -> [Int]
forall a b. (a, b) -> b
snd) [(String, [Int])]
obsSpec) ]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [ String
"LAW uses atoms not in VARS!" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Prp -> Bool) -> [Prp] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Prp -> [Prp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Prp]
vocab) (Form -> [Prp]
propsInForm Form
lawform) ]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [ String
"Query formula contains atoms not in VARS!" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Form -> Bool) -> [Form] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Prp -> Bool) -> [Prp] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Prp -> [Prp] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Prp]
vocab) ([Prp] -> Bool) -> (Form -> [Prp]) -> Form -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> [Prp]
propsInForm) [Form]
jobForms ]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [ String
"Query formula contains agents not in OBS!" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Form -> Bool) -> [Form] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
agents) ([String] -> Bool) -> (Form -> [String]) -> Form -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> [String]
agentsInForm) [Form]
jobForms ]
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [ String
"TRUE? query contains atoms not in VARS!" | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
vocabInts) [Int]
jobAtoms ]