ENH Validate count() headers on --validate-only

Also, a few other refactors/improvements, including making `staticValue`
more robust & generic by reusing the code for `evalBinary` (so that the
static evaluation and the runtime evaluation are exactly the same now).

ChangeLog

@@ -1,4 +1,5 @@
 Version 1.2.0+
+	* Validate count() headers on --validate-only
 	* Better error message if the user attempts to use the non-existent <\>
 	operator (suggest </>)
 	* Add min-ngless-version field for modules

NGLess/Interpret.hs

@@ -1,4 +1,4 @@
-{- Copyright 2013-2020 NGLess Authors
+{- Copyright 2013-2021 NGLess Authors
  - License: MIT
  -}
 {-# LANGUAGE FlexibleContexts, CPP #-}
@@ -84,7 +84,6 @@ import           Text.Read (readEither)
 
 import System.IO
 import System.Directory
-import System.FilePath ((</>))
 import Data.List (find)
 import GHC.Conc                 (getNumCapabilities)
 
@@ -731,37 +730,3 @@ _evalIndex (NGOShortRead sr) [Just (NGOInteger s), Just (NGOInteger e)] =
     return . NGOShortRead $ srSlice (fromInteger s) (fromInteger $ e - s) sr
 _evalIndex _ _ = nglTypeError ("_evalIndex: invalid operation" :: String)
 
-
-asDouble :: NGLessObject -> NGLess Double
-asDouble (NGODouble d) = return d
-asDouble (NGOInteger i) = return $ fromIntegral i
-asDouble other = throwScriptError ("Expected numeric value, got: " ++ show other)
-
-
--- Binary Evaluation
-evalBinary :: BOp ->  NGLessObject -> NGLessObject -> Either NGError NGLessObject
-evalBinary BOpAdd (NGOInteger a) (NGOInteger b) = Right $ NGOInteger (a + b)
-evalBinary BOpAdd (NGOString a) (NGOString b) = Right $ NGOString (T.concat [a, b])
-evalBinary BOpAdd a b = (NGODouble .) . (+) <$> asDouble a <*> asDouble b
-evalBinary BOpMul (NGOInteger a) (NGOInteger b) = Right $ NGOInteger (a * b)
-evalBinary BOpMul a b = (NGODouble .) . (+) <$> asDouble a <*> asDouble b
-evalBinary BOpPathAppend a b = case (a,b) of
-    (NGOString pa, NGOString pb) -> return . NGOString $! T.pack (T.unpack pa </> T.unpack pb)
-    _ -> nglTypeError ("Operator </>: invalid arguments" :: String)
-
-evalBinary BOpEQ (NGOString a) (NGOString b) = return . NGOBool $! a == b
-evalBinary BOpNEQ (NGOString a) (NGOString b) = return . NGOBool $! a /= b
-evalBinary op a b = do
-        a' <- asDouble a
-        b' <- asDouble b
-        return . NGOBool $ cmp op a' b'
-    where
-        cmp BOpLT = (<)
-        cmp BOpGT = (>)
-        cmp BOpLTE = (<=)
-        cmp BOpGTE = (>=)
-        cmp BOpEQ = (==)
-        cmp BOpNEQ = (/=)
-        cmp _ = error "should never occur"
-
-

NGLess/Language.hs

@@ -1,4 +1,4 @@
-{- Copyright 2013-2020 NGLess Authors
+{- Copyright 2013-2021 NGLess Authors
  - License: MIT
  -}
 
@@ -22,15 +22,19 @@ module Language
     , recursiveTransform
     , usedVariables
     , staticValue
+    , evalBinary
     ) where
 
 {- This module defines the internal representation the language -}
 import qualified Data.Text as T
+import           Data.Either.Extra (eitherToMaybe)
 import           Control.Monad.Extra (whenJust)
 import           Control.Monad.Writer
+import           System.FilePath ((</>))
 
 import Data.FastQ
 import Data.Sam
+import NGLess.NGError
 import FileOrStream
 
 newtype Variable = Variable T.Text
@@ -167,20 +171,52 @@ instance Show Expression where
 showArgs [] = ""
 showArgs ((Variable v, e):args) = "; "++T.unpack v++"="++show e++showArgs args
 
+{-- Extract static (ie, constant) values from expressions, if possible -}
 staticValue :: Expression -> Maybe NGLessObject
 staticValue (ConstStr s) = Just $ NGOString s
 staticValue (ConstInt v) = Just $ NGOInteger v
 staticValue (ConstBool b) = Just $ NGOBool b
 staticValue (ConstSymbol s) = Just $ NGOSymbol s
-staticValue (BinaryOp BOpAdd e1 e2) = do
+staticValue (BinaryOp bop e1 e2) = do
     v1 <- staticValue e1
     v2 <- staticValue e2
-    case (v1,v2) of
-        (NGOString s1, NGOString s2) -> return $ NGOString (T.concat [s1, s2])
-        (NGOInteger i1, NGOInteger i2) -> return $ NGOInteger (i1 + i2)
-        _ -> Nothing
+    eitherToMaybe $ evalBinary bop v1 v2
+staticValue (ListExpression e) = NGOList <$> mapM staticValue e
 staticValue _ = Nothing
 
+asDouble :: NGLessObject -> NGLess Double
+asDouble (NGODouble d) = return d
+asDouble (NGOInteger i) = return $ fromIntegral i
+asDouble other = throwScriptError ("Expected numeric value, got: " ++ show other)
+
+-- Binary Evaluation
+evalBinary :: BOp ->  NGLessObject -> NGLessObject -> Either NGError NGLessObject
+evalBinary BOpAdd (NGOInteger a) (NGOInteger b) = Right $ NGOInteger (a + b)
+evalBinary BOpAdd (NGOString a) (NGOString b) = Right $ NGOString (T.concat [a, b])
+evalBinary BOpAdd a b = (NGODouble .) . (+) <$> asDouble a <*> asDouble b
+evalBinary BOpMul (NGOInteger a) (NGOInteger b) = Right $ NGOInteger (a * b)
+evalBinary BOpMul a b = (NGODouble .) . (+) <$> asDouble a <*> asDouble b
+evalBinary BOpPathAppend a b = case (a,b) of
+    (NGOString pa, NGOString pb) -> return . NGOString $! T.pack (T.unpack pa </> T.unpack pb)
+    _ -> throwShouldNotOccur ("Operator </>: invalid arguments" :: String)
+
+evalBinary BOpEQ (NGOString a) (NGOString b) = return . NGOBool $! a == b
+evalBinary BOpNEQ (NGOString a) (NGOString b) = return . NGOBool $! a /= b
+evalBinary op a b = do
+        a' <- asDouble a
+        b' <- asDouble b
+        return . NGOBool $ cmp op a' b'
+    where
+        cmp BOpLT = (<)
+        cmp BOpGT = (>)
+        cmp BOpLTE = (<=)
+        cmp BOpGTE = (>=)
+        cmp BOpEQ = (==)
+        cmp BOpNEQ = (/=)
+        cmp _ = error "should never occur"
+
+
+
 -- 'recursiveAnalyse f e' will call the function 'f' for all the subexpression inside 'e'
 recursiveAnalyse :: (Monad m) => (Expression -> m ()) -> Expression -> m ()
 recursiveAnalyse f e = f e >> recursiveAnalyse' e

NGLess/StandardModules/Mocat.hs

@@ -15,7 +15,6 @@ import qualified Data.Conduit.List as CL
 import qualified Data.Conduit as C
 import           Data.Conduit ((.|))
 import           Data.Conduit.Algorithms.Async (conduitPossiblyCompressedFile)
-import Control.Monad.IO.Class (liftIO)
 import Control.Monad
 import Data.Default
 

NGLess/ValidationIO.hs

@@ -1,4 +1,4 @@
-{- Copyright 2013-2017 NGLess Authors
+{- Copyright 2013-2021 NGLess Authors
  - License: MIT
  -}
 
@@ -24,6 +24,7 @@ import FileManagement
 import Utils.Suggestion
 import ReferenceDatabases
 import BuiltinModules.Checks
+import Interpretation.Count (executeCountCheck)
 
 
 -- validation functions live in this Monad, where error messages can be written
@@ -32,7 +33,7 @@ liftNGLessIO = lift . lift
 tell1 = tell . (:[])
 
 findFunctionIO :: FuncName -> ValidateIO Function
-findFunctionIO fname = flip findFunction fname <$> ask >>= \case
+findFunctionIO fname = asks (flip findFunction fname) >>= \case
     Just finfo -> return finfo
     Nothing -> throwShouldNotOccur ("Cannot find information for function: " ++ show fname)
 
@@ -48,6 +49,7 @@ validateIO mods sc = do
             [validateReadInputs
             ,validateOFile
             ,checkReferencesExist
+            ,validateCount
             ]
 
 
@@ -145,3 +147,13 @@ checkOFileV ofile = do
     whenM (liftIO $ doesFileExist ofile') $
         liftNGLessIO $ outputListLno' WarningOutput ["Writing to file '", ofile', "' will overwrite existing file."]
 
+{- Attempt to run executeCountCheck in the validation stage
+ -}
+validateCount (Script _ es) = checkRecursive validateCount' es
+    where
+        validateCount' (FunctionCall (FuncName "count") _ kwargs Nothing) =
+            whenJust (constantKWArgs kwargs) (void . liftNGLessIO . executeCountCheck NGOVoid)
+        validateCount' _ = return ()
+        constantKWArgs :: [(Variable, Expression)] -> Maybe KwArgsValues
+        constantKWArgs = mapM $ \(Variable v, e) -> (v,) <$> staticValue e
+

Tests-Src/Tests.hs

@@ -1,4 +1,4 @@
-{- Copyright 2013-2020 NGLess Authors
+{- Copyright 2013-2021 NGLess Authors
  - License: MIT
  -}
 {-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
@@ -43,17 +43,18 @@ import Utils.Here
 import qualified Data.GFF as GFF
 
 import Tests.Utils
+import Tests.Count (tgroup_Count)
 import Tests.FastQ (tgroup_FastQ)
-import Tests.Validation (tgroup_Validation)
+import Tests.IntGroups (tgroup_IntGroups)
+import Tests.Language (tgroup_Language)
+import Tests.LoadFQDirectory (tgroup_LoadFQDirectory)
+import Tests.NGLessAPI (tgroup_NGLessAPI)
+import Tests.Parse (tgroup_Parse)
 import Tests.Select (tgroup_Select)
 import Tests.Types (tgroup_Types)
-import Tests.Count (tgroup_Count)
-import Tests.Parse (tgroup_Parse)
+import Tests.Validation (tgroup_Validation)
 import Tests.Vector (tgroup_Vector)
-import Tests.IntGroups (tgroup_IntGroups)
-import Tests.LoadFQDirectory (tgroup_LoadFQDirectory)
 import Tests.Write (tgroup_Write)
-import Tests.NGLessAPI (tgroup_NGLessAPI)
 
 test_FastQ      = [tgroup_FastQ]
 test_Validation = [tgroup_Validation]
@@ -64,6 +65,7 @@ test_NGLessAPI  = [tgroup_NGLessAPI]
 test_Vector     = [tgroup_Vector]
 test_IntGroups  = [tgroup_IntGroups]
 test_Select     = [tgroup_Select]
+test_Language   = [tgroup_Language]
 test_LoadFqDir  = [tgroup_LoadFQDirectory]
 test_Write      = [tgroup_Write]
 

Tests-Src/Tests/Language.hs

@@ -0,0 +1,27 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
+module Tests.Language
+    ( tgroup_Language
+    ) where
+
+import Test.Framework.TH
+import Test.Framework.Providers.HUnit
+import Test.HUnit
+
+import Language
+
+tgroup_Language = $(testGroupGenerator)
+
+case_staticValue1 =
+    staticValue (ListExpression [ConstStr "Hello"
+                    , BinaryOp BOpPathAppend
+                                (ConstStr "results-dir")
+                                (ConstStr "output.txt")])
+        @=? (Just $ NGOList [NGOString "Hello", NGOString "results-dir/output.txt"])
+
+case_staticValue2 = do
+    staticValue (ListExpression [ConstStr "Hello"
+                    , BinaryOp BOpPathAppend
+                                (ConstStr "results-dir")
+                                (ConstStr "output.txt")
+                    , Lookup Nothing (Variable "nope")])
+        @=? Nothing

Tests-Src/Tests/LoadFQDirectory.hs

@@ -8,7 +8,6 @@ import Test.HUnit
 import Test.Framework.Providers.HUnit
 
 import Control.Monad (forM_)
-import Control.Monad.IO.Class (liftIO)
 
 import BuiltinModules.LoadDirectory (matchUp)
 import Tests.Utils