diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,19 @@ +Version 1.5.0 2022-09-14 by luispedro + * Add `compress_level` option to `write()` function + * Add ability to specify samples using YAML format + * Make 'assemble' return NGLSequenceSet type and add sequenceset to + external modules + * Allow `::` in names (for module::function notation) + * Add `run_for_all` in parallel module + * Support .xz compressed files in load_fastq_directory + * Add `names()` method to readset + * Add ``println()`` function + * Make ``print()`` accept ints and doubles as well as strings + * Write log to .failed files when using the parallel module + * Fix bug where failhooks were not triggered for uncaught exceptions + * Change order of testing for locks in the parallel module for a more + robust protocol + Version 1.4.2 2022-07-21 by luispedro * Fix bug with parsing GFF files diff --git a/Execs/Main.hs b/Execs/Main.hs --- a/Execs/Main.hs +++ b/Execs/Main.hs @@ -45,6 +45,8 @@ import Control.Concurrent (setNumCapabilities) import System.Console.ANSI (setSGRCode, SGR(..), ConsoleLayer(..), Color(..), ColorIntensity(..)) import System.Exit (exitSuccess, exitFailure, ExitCode(..)) +import qualified UnliftIO.Exception +import qualified Control.Monad.Except import Control.Monad.Trans.Resource @@ -86,8 +88,9 @@ import qualified BuiltinModules.LoadDirectory as ModLoadDirectory import qualified BuiltinModules.Readlines as Readlines import qualified BuiltinModules.Remove as Remove -import qualified BuiltinModules.QCStats as ModQCStats import qualified BuiltinModules.ORFFind as ModORFFind +import qualified BuiltinModules.Samples as ModSamples +import qualified BuiltinModules.QCStats as ModQCStats -- | wrapPrint transforms the script by transforming the last expression @@ -154,11 +157,13 @@ mChecks <- Checks.loadModule ("" :: T.Text) mRemove <- Remove.loadModule ("" :: T.Text) mStats <- ModQCStats.loadModule ("" :: T.Text) + mSamples <- ModSamples.loadModule ("" :: T.Text) mOrfFind <- ModORFFind.loadModule ("0.6" :: T.Text) imported <- loadStdlibModules mods let loaded = [builtinModule av] ++ [mOrfFind | av >= NGLVersion 0 6] ++ [mLoadDirectory | av >= NGLVersion 1 2] + ++ [mSamples | av >= NGLVersion 1 5] ++ [mReadlines, mArgv, mAssemble, mA, mChecks, mRemove, mStats] ++ imported forM_ loaded registerModule return loaded @@ -276,15 +281,25 @@ writeCWL sc fname cwlname exitSuccess outputListLno' InfoOutput ["Script OK. Starting interpretation..."] - interpret modules (nglBody transformed) - triggerHook FinishOkHook - whenM (nConfCreateReportDirectory <$> nglConfiguration) $ do - odir <- nConfReportDirectory <$> nglConfiguration - liftIO $ createDirectoryIfMissing False odir - liftIO $ setupHtmlViewer odir - liftIO $ T.writeFile (odir "script.ngl") ngltext - writeOutputJSImages odir fname ngltext - writeOutputTSV False (Just $ odir "fq.tsv") (Just $ odir "mappings.tsv") + UnliftIO.Exception.try (interpret modules (nglBody transformed)) >>= \case + Left e -> case fromException e of + Just ec -> liftIO $ throwIO (ec :: ExitCode) -- rethrow + Nothing -> case fromException e of + Just e@NGError{} -> Control.Monad.Except.throwError e + Nothing -> do + outputListLno' ErrorOutput [show e] + liftIO $ do + triggerFailHook + fatalError (show e) + Right () -> do + triggerHook FinishOkHook + whenM (nConfCreateReportDirectory <$> nglConfiguration) $ do + odir <- nConfReportDirectory <$> nglConfiguration + liftIO $ createDirectoryIfMissing False odir + liftIO $ setupHtmlViewer odir + liftIO $ T.writeFile (odir "script.ngl") ngltext + writeOutputJS odir fname ngltext + writeOutputTSV False (Just $ odir "fq.tsv") (Just $ odir "mappings.tsv") exitSuccess @@ -380,7 +395,8 @@ mapM_ makeEncodingSafe [stdout, stdin, stderr] catch main' $ \e -> case fromException e of Just ec -> throwIO (ec :: ExitCode) -- rethrow - Nothing -> + Nothing -> do + triggerFailHook fatalError ("An unhandled error occurred (this should not happen)!\n\n" ++ "\tIf you can reproduce this issue, please run your script\n" ++ "\twith the --trace flag and report a bug (including the script and the trace) at\n" ++ diff --git a/NGLess.cabal b/NGLess.cabal --- a/NGLess.cabal +++ b/NGLess.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: NGLess -version: 1.4.2.0 +version: 1.5.0 synopsis: NGLess implements ngless, a DSL for processing sequencing data description: NGLess implements a domain-specific language for processing next generation data, particularly metagenomics. category: Domain Specific Language @@ -56,6 +56,7 @@ BuiltinModules.QCStats BuiltinModules.Readlines BuiltinModules.Remove + BuiltinModules.Samples Citations CmdArgs Configuration @@ -154,9 +155,6 @@ , convertible , data-default , deepseq >=1.3 - , diagrams-core - , diagrams-lib - , diagrams-svg , directory , edit-distance >=0.2 , either @@ -180,6 +178,7 @@ , parsec >=3.1 , primitive >=0.6 , process >=1.2.3 + , random-shuffle , regex , resourcet >=1.1 , safe @@ -248,9 +247,6 @@ , convertible , data-default , deepseq >=1.3 - , diagrams-core - , diagrams-lib - , diagrams-svg , directory , edit-distance >=0.2 , either @@ -274,6 +270,7 @@ , parsec >=3.1 , primitive >=0.6 , process >=1.2.3 + , random-shuffle , regex , resourcet >=1.1 , safe @@ -325,6 +322,7 @@ BuiltinModules.QCStats BuiltinModules.Readlines BuiltinModules.Remove + BuiltinModules.Samples Citations CmdArgs Configuration @@ -397,6 +395,7 @@ Tests.LoadFQDirectory Tests.NGLessAPI Tests.Parse + Tests.Samples Tests.Select Tests.Types Tests.Utils @@ -439,9 +438,6 @@ , convertible , data-default , deepseq >=1.3 - , diagrams-core - , diagrams-lib - , diagrams-svg , directory , edit-distance >=0.2 , either @@ -465,6 +461,7 @@ , parsec >=3.1 , primitive >=0.6 , process >=1.2.3 + , random-shuffle , regex , resourcet >=1.1 , safe @@ -538,9 +535,6 @@ , criterion , data-default , deepseq >=1.3 - , diagrams-core - , diagrams-lib - , diagrams-svg , directory , edit-distance >=0.2 , either @@ -564,6 +558,7 @@ , parsec >=3.1 , primitive >=0.6 , process >=1.2.3 + , random-shuffle , regex , resourcet >=1.1 , safe diff --git a/NGLess/BuiltinFunctions.hs b/NGLess/BuiltinFunctions.hs --- a/NGLess/BuiltinFunctions.hs +++ b/NGLess/BuiltinFunctions.hs @@ -1,4 +1,4 @@ -{- Copyright 2013-2021 NGLess Authors +{- Copyright 2013-2022 NGLess Authors - License: MIT -} module BuiltinFunctions @@ -38,6 +38,8 @@ , modFunctions = builtinFunctions ver } +printType = NGLUnion [NGLString, NGLInteger, NGLDouble] + builtinFunctions ver = [Function (FuncName "fastq") (Just NGLString) [ArgCheckFileReadable] NGLReadSet fastqArgs False [] ,Function (FuncName "paired") (Just NGLString) [ArgCheckFileReadable] NGLReadSet pairedArgs False [] @@ -56,7 +58,8 @@ ,Function (FuncName "countfile") (Just NGLString) [ArgCheckFileReadable] NGLCounts [] False [FunctionCheckReturnAssigned] ,Function (FuncName "write") (Just NGLAny) [] (if ver >= NGLVersion 1 4 then NGLString else NGLVoid) writeArgs False [] - ,Function (FuncName "print") (Just NGLAny) [] NGLVoid [] False [] + ,Function (FuncName "print") (Just printType) [] NGLVoid [] False [] + ,Function (FuncName "println") (Just printType) [] NGLVoid [] False [] ,Function (FuncName "read_int") (Just NGLString) [] NGLInteger [ArgInformation "on_empty_return" False NGLInteger []] False [] ,Function (FuncName "read_double") (Just NGLString) [] NGLDouble [ArgInformation "on_empty_return" False NGLDouble []] False [] @@ -78,6 +81,7 @@ ,ArgInformation "verbose" False NGLBool [] ,ArgInformation "comment" False NGLString [] ,ArgInformation "auto_comments" False (NGList NGLSymbol) [ArgCheckSymbol ["date", "script", "hash"]] + ,ArgInformation "compress_level" False NGLInteger [ArgCheckMinVersion (1,5)] ] countArgs = @@ -123,8 +127,8 @@ ] ] pairedArgs = - [ArgInformation "second" True NGLString [] - ,ArgInformation "singles" False NGLString [] + [ArgInformation "second" True NGLString [ArgCheckFileReadable] + ,ArgInformation "singles" False NGLString [ArgCheckFileReadable] ,ArgInformation "encoding" False NGLSymbol [ArgCheckSymbol ["auto", "33", "64", "sanger", "solexa"]] ,ArgInformation "__perform_qc" False NGLBool [] ] @@ -178,6 +182,9 @@ ,MethodInfo (MethodName "avg_quality") NGLRead Nothing NGLDouble [] True [] ,MethodInfo (MethodName "fraction_at_least") NGLRead (Just NGLInteger) NGLDouble [] True [] ,MethodInfo (MethodName "n_to_zero_quality") NGLRead Nothing NGLRead [] True [FunctionCheckMinNGLessVersion (0,8)] + + -- NGLReadSet + ,MethodInfo (MethodName "name") NGLReadSet Nothing NGLString [] True [] -- NGLDouble ,MethodInfo (MethodName "to_string") NGLDouble Nothing NGLString [] True [] diff --git a/NGLess/BuiltinModules/Assemble.hs b/NGLess/BuiltinModules/Assemble.hs --- a/NGLess/BuiltinModules/Assemble.hs +++ b/NGLess/BuiltinModules/Assemble.hs @@ -60,14 +60,14 @@ outputListLno' DebugOutput ["Calling megahit: ", megahitPath, " ", unwords args] runProcess megahitPath args (return ()) (Left ()) release mt - return $! NGOFilename (odir "final.contigs.fa") + return $! NGOSequenceSet (odir "final.contigs.fa") executeAssemble _ _ _ = throwScriptError "unexpected code path taken [megahit:assemble]" assembleFunction = Function { funcName = FuncName "assemble" , funcArgType = Just NGLReadSet , funcArgChecks = [] - , funcRetType = NGLString + , funcRetType = NGLSequenceSet , funcKwArgs = [ArgInformation "__extra_megahit_args" False (NGList NGLString) []] , funcAllowsAutoComprehension = False , funcChecks = diff --git a/NGLess/BuiltinModules/Checks.hs b/NGLess/BuiltinModules/Checks.hs --- a/NGLess/BuiltinModules/Checks.hs +++ b/NGLess/BuiltinModules/Checks.hs @@ -11,6 +11,7 @@ import qualified Data.Text as T import Data.Default (def) +import Control.Monad.Extra (whenJust) import Control.Monad.Except import System.Directory import System.FilePath (takeDirectory) @@ -37,17 +38,19 @@ executeChecks :: T.Text -> NGLessObject -> KwArgsValues -> NGLessIO NGLessObject executeChecks "__check_ofile" expr args = do - oname <- stringOrTypeError "o file check" expr + oname <- stringOrTypeError "output file check" expr lno <- lookupIntegerOrScriptError "o file lno" "original_lno" args liftIO (checkOFile oname) >>= \case Nothing -> return NGOVoid Just err -> throwSystemError $! concat [T.unpack err, " (used in line ", show lno, ")."] executeChecks "__check_ifile" expr args = do - oname <- stringOrTypeError "input file check" expr - lno <- lookupIntegerOrScriptError "inputo file lno" "original_lno" args - liftIO (checkFileReadable $ T.unpack oname) >>= \case - Nothing -> return NGOVoid - Just err -> throwSystemError $! concat [T.unpack err, " (used in line ", show lno, ")."] + fname <- filepathOrTypeError "checking input file" expr + lno <- lookupIntegerOrScriptError "input file lno" "original_lno" args + merr <- liftIO (checkFileReadable fname) + whenJust merr $ \err -> + throwSystemError $! concat [T.unpack err, " (used in line ", show lno, ")."] + return NGOVoid + executeChecks "__check_index_access" (NGOList vs) args = do lno <- lookupIntegerOrScriptError "index access check" "original_lno" args index1 <- lookupIntegerOrScriptError "index access check" "index1" args diff --git a/NGLess/BuiltinModules/LoadDirectory.hs b/NGLess/BuiltinModules/LoadDirectory.hs --- a/NGLess/BuiltinModules/LoadDirectory.hs +++ b/NGLess/BuiltinModules/LoadDirectory.hs @@ -1,6 +1,6 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE CPP #-} -{- Copyright 2016-2020 NGLess Authors +{- Copyright 2016-2022 NGLess Authors - License: MIT -} @@ -33,7 +33,7 @@ exts :: [FilePath] exts = do fq <- ["fq", "fastq"] - comp <- ["", ".gz", ".bz2"] + comp <- ["", ".gz", ".bz2", ".xz"] return $! fq ++ comp pairedEnds :: [(String, String)] diff --git a/NGLess/BuiltinModules/ORFFind.hs b/NGLess/BuiltinModules/ORFFind.hs --- a/NGLess/BuiltinModules/ORFFind.hs +++ b/NGLess/BuiltinModules/ORFFind.hs @@ -1,4 +1,4 @@ -{- Copyright 2017-2019 NGLess Authors +{- Copyright 2017-2022 NGLess Authors - License: MIT -} @@ -23,7 +23,7 @@ executeORFFind :: T.Text -> NGLessObject -> KwArgsValues -> NGLessIO NGLessObject executeORFFind "orf_find" expr kwargs = do input <- case expr of - NGOSequenceSet f -> return f + NGOSequenceSet f -> return $ File f NGOFilename f -> return $ File f NGOString f -> return $ File (T.unpack f) _ -> throwScriptError ("orf_find first argument should have been sequenceset, got '"++show expr++"'") diff --git a/NGLess/BuiltinModules/Samples.hs b/NGLess/BuiltinModules/Samples.hs new file mode 100644 --- /dev/null +++ b/NGLess/BuiltinModules/Samples.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE CPP #-} +{- Copyright 2022 NGLess Authors + - License: MIT + -} + +module BuiltinModules.Samples + ( loadModule +#ifdef IS_BUILDING_TEST + , executeLoadSample + , executeLoadSampleList +#endif + ) where + +import qualified Data.ByteString as B +import qualified Data.Text as T +import Data.List (find) +import Data.Default (def) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson +import Data.Aeson.Types ((.:), (.:?)) +import Data.Either (lefts, rights) +import qualified Data.Aeson.KeyMap as Aeson +import qualified Data.Aeson.Key as Aeson +import qualified Data.Yaml as Yaml +import qualified Data.Vector as V +import Control.Monad.IO.Class (liftIO) +import System.FilePath ((), isAbsolute) + + +import Language + +import Data.FastQ +import Modules +import NGLess + +data SampleData = SampleData + { sampleName :: !T.Text + , sampleData :: ReadSet + } deriving (Eq, Ord, Show) + -- equivalent to NGOReadSet + +data SampleFile = SampleFile + { sfBasedir :: Maybe FilePath + , sfSamples :: [SampleData] + } deriving (Eq, Ord, Show) + + +instance Aeson.FromJSON SampleFile where + parseJSON = Aeson.withObject "SampleFile" $ \ob -> do + samples <- ob .: "samples" + SampleFile + <$> ob .:? "basedir" + <*> parseSamples samples + +parseSamples :: Aeson.Value -> Aeson.Parser [SampleData] +parseSamples = Aeson.withObject "samples" $ \ss -> + mapM parseSample (Aeson.toList ss) + +parseSample :: (Aeson.Key, Aeson.Value) -> Aeson.Parser SampleData +parseSample (name, elems) = do + data_ <- parseSamplePaths (Aeson.toText name) elems + return $ SampleData (Aeson.toText name) data_ + +parseSamplePaths :: T.Text -> Aeson.Value -> Aeson.Parser ReadSet +parseSamplePaths name = Aeson.withArray "paths" $ \arr -> do + paths <- mapM (parseSamplePath name) (V.toList arr) + return $ ReadSet + (map (\(a,b) -> + (FastQFilePath SangerEncoding a, FastQFilePath SangerEncoding b) + ) $ lefts paths) + (map (FastQFilePath SangerEncoding) $ rights paths) + +parseSamplePath :: T.Text -> Aeson.Value -> Aeson.Parser (Either (FilePath, FilePath) FilePath) +parseSamplePath name = Aeson.withObject "path" $ \ob -> do + case Aeson.toList ob of + [("paired", elems)] -> flip (Aeson.withArray "paired") elems $ \v -> + case V.toList v of + [Aeson.String fq1, Aeson.String fq2] -> return $ Left (T.unpack fq1, T.unpack fq2) + _ -> fail ("Invalid paired sample '" ++ T.unpack name ++ "'") + [("single", elems)] -> case elems of + Aeson.String fq1 -> return . Right $ T.unpack fq1 + Aeson.Array arr -> case V.toList arr of + [Aeson.String fq1] -> return . Right $ T.unpack fq1 + _ -> fail ("Invalid sample '" ++ T.unpack name ++ "'") + _ -> fail ("Invalid sample '" ++ T.unpack name ++ "' (parsing 'single' entry)") + _ -> fail ("Invalid sample '" ++ T.unpack name ++ "'") + +normalize :: SampleFile -> [NGLessObject] +normalize (SampleFile maybeBasedir samples) = + map norm1 samples + where + norm1 :: SampleData -> NGLessObject + norm1 (SampleData name data_) = + NGOReadSet name (maybeAddBasedir maybeBasedir data_) + + addBaseDir1 :: FilePath -> FastQFilePath -> FastQFilePath + addBaseDir1 basedir f@(FastQFilePath enc fq) + | isAbsolute fq = f + | otherwise = FastQFilePath enc $ basedir fq + + maybeAddBasedir :: Maybe FilePath -> ReadSet -> ReadSet + maybeAddBasedir Nothing data_ = data_ + maybeAddBasedir (Just basedir) (ReadSet pairs singles) = + ReadSet + (map (\(a,b) -> (addBaseDir1 basedir a, addBaseDir1 basedir b)) pairs) + (map (addBaseDir1 basedir) singles) + +executeLoadSampleList :: NGLessObject -> KwArgsValues -> NGLessIO NGLessObject +executeLoadSampleList (NGOString fname) _ = do + Yaml.decodeEither' <$> liftIO (B.readFile $ T.unpack fname) >>= \case + Right sf -> return $ NGOList $ normalize sf + Left err -> throwSystemError ("Could not sample information file "++ (T.unpack fname) ++ ". Error was `" ++ show err ++ "`") +executeLoadSampleList arg _ = throwShouldNotOccur ("load_sample_list called with argument: " ++ show arg) + +executeLoadSample :: NGLessObject -> KwArgsValues -> NGLessIO NGLessObject +executeLoadSample fname kwargs = do + sample <- lookupStringOrScriptError "load_sample_from_yaml arguments" "sample" kwargs + samples <- executeLoadSampleList fname [] + case samples of + NGOList l -> case find (\(NGOReadSet n _) -> n == sample) l of + Just s -> return s + _ -> throwDataError ("load_sample_from_yaml: sample " ++ show sample ++ " not found in file " ++ show fname) + _ -> throwShouldNotOccur "load_sample_from_yaml: sample list is not a list" + + +yamlFunctions = + [ Function + { funcName = FuncName "load_sample_list" + , funcArgType = Just NGLString + , funcArgChecks = [ArgCheckFileReadable] + , funcRetType = NGList NGLReadSet + , funcKwArgs = [] + , funcAllowsAutoComprehension = True + , funcChecks = [FunctionCheckMinNGLessVersion (1,5) + ,FunctionCheckReturnAssigned] + } + , Function + { funcName = FuncName "load_sample_from_yaml" + , funcArgType = Just NGLString + , funcArgChecks = [ArgCheckFileReadable] + , funcRetType = NGList NGLReadSet + , funcKwArgs = [ArgInformation "sample" True (NGList NGLString) []] + , funcAllowsAutoComprehension = True + , funcChecks = [FunctionCheckMinNGLessVersion (1,5) + ,FunctionCheckReturnAssigned] + } + ] + +loadModule :: T.Text -> NGLessIO Module +loadModule _ = return def + { modInfo = ModInfo "builtin.samples" "1.5" + , modFunctions = yamlFunctions + , runFunction = \case + "load_sample_list" -> executeLoadSampleList + "load_sample_from_yaml" -> executeLoadSample + _ -> error "NOT POSSIBLE" + } diff --git a/NGLess/Citations.hs b/NGLess/Citations.hs --- a/NGLess/Citations.hs +++ b/NGLess/Citations.hs @@ -21,7 +21,7 @@ nglessCitation :: T.Text nglessCitation = - "Coelho, L.P., Alves, R., Monteiro, P., Huerta-Cepas, J., Freitas, A.T., and Bork, P., NG-meta-profiler: fast processing of metagenomes using NGLess, a domain-specific language. in Microbiome 7:84 (2019). DOI: http://doi.org/10.1186/s40168-019-0684-8" + "Coelho, L.P., Alves, R., Monteiro, P., Huerta-Cepas, J., Freitas, A.T., and Bork, P., NG-meta-profiler: fast processing of metagenomes using NGLess, a domain-specific language. in Microbiome 7:84 (2019). DOI: https://doi.org/10.1186/s40168-019-0684-8" collectCitations :: [Module] -> Script -> [T.Text] diff --git a/NGLess/ExternalModules.hs b/NGLess/ExternalModules.hs --- a/NGLess/ExternalModules.hs +++ b/NGLess/ExternalModules.hs @@ -1,4 +1,4 @@ -{- Copyright 2015-2021 NGLess Authors +{- Copyright 2015-2022 NGLess Authors - License: MIT -} @@ -58,6 +58,7 @@ | SamFile | BamFile | SamOrBamFile + | FastaFile | TSVFile deriving (Eq,Show) @@ -120,6 +121,7 @@ "readset" -> return (NGLReadSet, Nothing) "counts" -> return (NGLCounts, Nothing) "mappedreadset" -> return (NGLMappedReadSet, Nothing) + "sequenceset" -> return (NGLSequenceSet, Nothing) _ -> fail ("unknown argument type "++atype) argChecks <- if atype == "option" then do @@ -145,6 +147,7 @@ "counts" -> return NGLCounts "readset" -> return NGLReadSet "mappedreadset" -> return NGLMappedReadSet + "sequenceset" -> return NGLSequenceSet other -> fail ("Cannot parse unknown type '"++T.unpack other++"'") data CommandReturn = CommandReturn @@ -301,6 +304,7 @@ Just (newfp, _) -> case commandReturnType $ ret cmd of NGLCounts -> return $ NGOCounts (File newfp) NGLMappedReadSet -> return $ NGOMappedReadSet (groupName input) (File newfp) Nothing + NGLSequenceSet -> return $ NGOSequenceSet newfp ret -> throwShouldNotOccur ("Not implemented (ExternalModules.hs:executeCommand commandReturnType = "++show ret++")") adjustCompression :: Maybe CommandExtra -> FilePath -> NGLessIO FilePath @@ -337,6 +341,7 @@ SamFile -> asSamFile filepath payload BamFile -> asBamFile filepath SamOrBamFile -> adjustCompression payload filepath + FastaFile -> adjustCompression payload filepath _ -> throwScriptError "Unexpected combination of arguments" Just other -> throwShouldNotOccur ("encodeArgument: unexpected payload: "++show other) asFilePaths invalid _ = throwShouldNotOccur ("AsFile path got "++show invalid) @@ -483,6 +488,7 @@ ,(NGLMappedReadSet, SamFile) ,(NGLMappedReadSet, BamFile) ,(NGLMappedReadSet, SamOrBamFile) + ,(NGLSequenceSet, FastaFile) ,(NGLCounts, TSVFile) ] diff --git a/NGLess/Interpret.hs b/NGLess/Interpret.hs --- a/NGLess/Interpret.hs +++ b/NGLess/Interpret.hs @@ -1,4 +1,4 @@ -{- Copyright 2013-2021 NGLess Authors +{- Copyright 2013-2022 NGLess Authors - License: MIT -} {-# LANGUAGE FlexibleContexts, CPP #-} @@ -234,7 +234,7 @@ NGOFilename f -> [f] NGOShortRead _ -> [] NGOReadSet _ rs -> extractFilesRS rs - NGOSequenceSet s -> origin s + NGOSequenceSet f -> [f] NGOMappedReadSet _ s _ -> origin s NGOMappedRead _ -> [] NGOCounts s -> origin s @@ -334,6 +334,7 @@ interpretFunction' (FuncName "__check_count") expr args Nothing = runNGLessIO (executeCountCheck expr args) interpretFunction' (FuncName "countfile") expr args Nothing = runNGLessIO (executeCountFile expr args) interpretFunction' (FuncName "print") expr args Nothing = executePrint expr args +interpretFunction' (FuncName "println") expr args Nothing = executePrint expr args >> executePrint (NGOString "\n") args interpretFunction' (FuncName "read_int") expr args Nothing = executeReadInt expr args interpretFunction' (FuncName "read_double") expr args Nothing = executeReadDouble expr args interpretFunction' (FuncName "paired") mate1 args Nothing = runNGLessIO (executePaired mate1 args) @@ -520,6 +521,7 @@ executeMethod method (NGOShortRead sr) arg kwargs = runNGLess (executeShortReadsMethod method sr arg kwargs) executeMethod (MethodName "to_string") (NGODouble val) _ _ = return . NGOString . T.pack . show $ val executeMethod (MethodName "to_string") (NGOInteger val) _ _ = return . NGOString . T.pack . show $ val +executeMethod (MethodName "name") (NGOReadSet n _) _ _ = return $ NGOString n executeMethod m self arg kwargs = throwShouldNotOccur ("Method " ++ show m ++ " with self="++show self ++ " arg="++ show arg ++ " kwargs="++show kwargs ++ " is not implemented") @@ -536,6 +538,8 @@ executePrint :: NGLessObject -> [(T.Text, NGLessObject)] -> InterpretationEnvIO NGLessObject executePrint (NGOString s) [] = liftIO (T.putStr s) >> return NGOVoid +executePrint (NGOInteger i) [] = liftIO (putStr $ show i) >> return NGOVoid +executePrint (NGODouble d) [] = liftIO (putStr $ show d) >> return NGOVoid executePrint err _ = throwScriptError ("Cannot print " ++ show err) executeReadInt :: NGLessObject -> [(T.Text, NGLessObject)] -> InterpretationEnvIO NGLessObject diff --git a/NGLess/Interpretation/Map.hs b/NGLess/Interpretation/Map.hs --- a/NGLess/Interpretation/Map.hs +++ b/NGLess/Interpretation/Map.hs @@ -169,7 +169,7 @@ (Nothing, Nothing) -> throwScriptError "Either reference or fafile must be passed" (Just _, Just _) -> throwScriptError "Reference and fafile cannot be used simmultaneously" (Just r, Nothing) -> PackagedReference <$> stringOrTypeError "reference in map argument" r - (Nothing, Just fa) -> (FaFile . T.unpack) <$> stringOrTypeError "fafile in map argument" fa + (Nothing, Just fa) -> FaFile <$> filepathOrTypeError "fafile in map argument" fa mapToReference :: Mapper -> FilePath -> ReadSet -> [String] -> NGLessIO (FilePath, (Int, Int, Int)) diff --git a/NGLess/Interpretation/Write.hs b/NGLess/Interpretation/Write.hs --- a/NGLess/Interpretation/Write.hs +++ b/NGLess/Interpretation/Write.hs @@ -7,6 +7,7 @@ module Interpretation.Write ( executeWrite , moveOrCopyCompress + , WriteOptions(..) #ifdef IS_BUILDING_TEST , _formatFQOname #endif @@ -14,10 +15,11 @@ +import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.Text as T import qualified Data.Vector as V -import qualified Data.Conduit as C +import qualified Conduit as C import qualified Data.Conduit.List as CL import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.Combinators as CC @@ -26,6 +28,7 @@ import qualified Data.Conduit.Algorithms.Async as CAsync import Data.Conduit ((.|)) import System.Directory (copyFile) +import Data.Default (Default(..)) import Data.Maybe import Data.String.Utils (replace, endswith) import Control.Monad.IO.Unlift (MonadUnliftIO) @@ -66,15 +69,29 @@ , woComment :: Maybe T.Text , woAutoComment :: [AutoComment] , woHash :: T.Text + , woCompressLevel :: Maybe Int } deriving (Eq) +instance Default WriteOptions where + def = WriteOptions + { woOFile= "" + , woFormat = Nothing + , woFormatFlags = Nothing + , woCanMove = False + , woVerbose = False + , woComment = Nothing + , woAutoComment = [] + , woHash = "" + , woCompressLevel = Nothing + } -ostream fp = case inferCompression fp of +ostream :: (MonadUnliftIO m, C.MonadResource m) => FilePath -> Maybe Int -> Handle -> C.ConduitT B.ByteString C.Void m () +ostream fp comp = case inferCompression fp of NoCompression -> CB.sinkHandle - GzipCompression -> CAsync.asyncGzipTo + GzipCompression -> maybe CAsync.asyncGzipTo CAsync.asyncGzipTo' comp BZ2Compression -> CAsync.asyncBzip2To - XZCompression -> CAsync.asyncXzTo - ZStdCompression -> CAsync.asyncZstdTo 3 -- compression level + XZCompression -> maybe CAsync.asyncXzTo CAsync.asyncXzTo' comp + ZStdCompression -> CAsync.asyncZstdTo (fromMaybe 3 comp) withOutputFile' :: (MonadUnliftIO m, MonadMask m) => FilePath -> (Handle -> m a) -> m a withOutputFile' "/dev/stdout" = \inner -> inner stdout @@ -107,6 +124,10 @@ Nothing -> return Nothing Just (NGOSymbol flag) -> return $ Just flag Just other -> throwScriptError $ "format_flags argument to write(): illegal argument ("++show other++")" + compressLevel <- case lookup "compress_level" args of + Nothing -> return Nothing + Just (NGOInteger level) -> return . Just $ fromEnum level + Just other -> throwScriptError $ "compress_level argument to write(): illegal argument ("++show other++")" return $! WriteOptions { woOFile = ofile , woFormat = format @@ -116,16 +137,17 @@ , woComment = comment , woAutoComment = autoComments , woHash = hash + , woCompressLevel = compressLevel } -moveOrCopyCompress :: Bool -> FilePath -> FilePath -> NGLessIO () -moveOrCopyCompress moveAllowed ifile ofile = liftIO =<< moveOrCopyCompress' moveAllowed ifile ofile +moveOrCopyCompress :: WriteOptions -> FilePath -> NGLessIO () +moveOrCopyCompress opts ifile = liftIO =<< moveOrCopyCompress' opts ifile -moveOrCopyCompress' :: Bool -> FilePath -> FilePath -> NGLessIO (IO ()) -moveOrCopyCompress' _ ifile "/dev/stdout" = return (C.runConduitRes $ conduitPossiblyCompressedFile ifile .| C.stdout) -moveOrCopyCompress' moveAllowed ifile ofile - | ifile == ofile = return (return ()) -- trivial case. Can happen. +moveOrCopyCompress' :: WriteOptions -> FilePath -> NGLessIO (IO ()) +moveOrCopyCompress' opts ifile + | ofile == "/dev/stdout" = return (C.runConduitRes $ conduitPossiblyCompressedFile ifile .| C.stdout) + | ofile == ifile = return (return ()) -- trivial case. Can happen. #ifdef WINDOWS | ocompression == BZ2Compression = throwNotImplementedError "Compression of bzip2 files is not supported on Windows" | icompression == BZ2Compression = throwNotImplementedError "Decompression of bzip2 files is not supported on Windows" @@ -133,10 +155,11 @@ | icompression == ocompression = moveIfAllowed | otherwise = convertCompression where + ofile = woOFile opts moveIfAllowed :: NGLessIO (IO ()) moveIfAllowed = do createdFiles <- ngleTemporaryFilesCreated <$> nglEnvironment - if moveAllowed && ifile `elem` createdFiles + if woCanMove opts && ifile `elem` createdFiles then return (moveOrCopy ifile ofile) else return (copyFile ifile ofile) @@ -145,7 +168,7 @@ convertCompression = return $ withOutputFile' ofile $ \hout -> - C.runConduitRes (conduitPossiblyCompressedFile ifile .| ostream ofile hout) + C.runConduitRes (conduitPossiblyCompressedFile ifile .| ostream ofile (woCompressLevel opts) hout) removeEnd :: String -> String -> String @@ -175,18 +198,18 @@ let ofile = woOFile opts moveOrCopyCompressFQs :: [FastQFilePath] -> FilePath -> NGLessIO (IO ()) moveOrCopyCompressFQs [] _ = return (return ()) - moveOrCopyCompressFQs [FastQFilePath _ f] ofname = moveOrCopyCompress' (woCanMove opts) f ofname + moveOrCopyCompressFQs [FastQFilePath _ f] ofname = moveOrCopyCompress' (opts {woOFile = ofname}) f moveOrCopyCompressFQs multiple ofname = do let inputs = fqpathFilePath <$> multiple fp' <- makeNGLTempFile (head inputs) "concat" "tmp" $ \h -> C.runConduit (mapM_ conduitPossiblyCompressedFile inputs .| C.sinkHandle h) - moveOrCopyCompress' True fp' ofname + moveOrCopyCompress' (opts {woCanMove = True, woOFile = ofname}) fp' if woFormatFlags opts == Just "interleaved" then withOutputFile' ofile $ \hout -> C.runConduitRes $ - interleaveFQs rs .| ostream ofile hout + interleaveFQs rs .| ostream ofile (woCompressLevel opts) hout else case rs of ReadSet [] singles -> liftIO =<< moveOrCopyCompressFQs singles ofile @@ -229,7 +252,7 @@ | endswith ".bam" fp -> return fp -- We already have a BAM, so just copy it | otherwise -> convertSamToBam fp s -> throwScriptError ("write does not accept format {" ++ T.unpack s ++ "} with input type " ++ show el) - moveOrCopyCompress (woCanMove opts) orig (woOFile opts) + moveOrCopyCompress opts orig return (NGOFilename $ woOFile opts) executeWrite (NGOCounts iout) args = do @@ -240,7 +263,7 @@ "tsv" -> do fp <- asFile iout case comment of - [] -> moveOrCopyCompress (woCanMove opts) fp (woOFile opts) + [] -> moveOrCopyCompress opts fp _ -> C.runConduit $ (commentC "# " comment >> CB.sourceFile fp) .| CB.sinkFileCautious (woOFile opts) @@ -252,7 +275,7 @@ .| CL.map (V.map tabToComma) .| CC.concat .| byteLineSinkHandle ohand - moveOrCopyCompress True comma (woOFile opts) + moveOrCopyCompress (opts { woCanMove = True}) comma f -> throwScriptError ("Invalid format in write: {"++T.unpack f++"}.\n\tWhen writing counts, only accepted values are {tsv} (TAB separated values; default) or {csv} (COMMA separated values).") return (NGOFilename $ woOFile opts) where @@ -261,8 +284,13 @@ executeWrite (NGOFilename fp) args = do opts <- parseWriteOptions args - moveOrCopyCompress (woCanMove opts) fp (woOFile opts) + moveOrCopyCompress opts fp return (NGOFilename $ woOFile opts) + +executeWrite (NGOSequenceSet fp) args = do + opts <- parseWriteOptions args + moveOrCopyCompress opts fp + return $ NGOSequenceSet (woOFile opts) executeWrite v _ = throwShouldNotOccur ("Error: executeWrite of " ++ show v ++ " not implemented yet.") diff --git a/NGLess/Language.hs b/NGLess/Language.hs --- a/NGLess/Language.hs +++ b/NGLess/Language.hs @@ -1,4 +1,4 @@ -{- Copyright 2013-2021 NGLess Authors +{- Copyright 2013-2022 NGLess Authors - License: MIT -} @@ -86,6 +86,7 @@ | NGLSequenceSet | NGLCounts | NGLVoid + | NGLUnion [NGLType] | NGLAny | NGList !NGLType deriving (Eq, Ord, Show) @@ -100,7 +101,7 @@ | NGOFilename !FilePath | NGOShortRead !ShortRead | NGOReadSet T.Text ReadSet - | NGOSequenceSet FileOrStream + | NGOSequenceSet !FilePath | NGOMappedReadSet { nglgroupName :: T.Text , nglSamFile :: FileOrStream diff --git a/NGLess/NGLess.hs b/NGLess/NGLess.hs --- a/NGLess/NGLess.hs +++ b/NGLess/NGLess.hs @@ -16,6 +16,7 @@ , boolOrTypeError , symbolOrTypeError , stringOrTypeError + , filepathOrTypeError , integerOrTypeError , decodeSymbolOrError , lookupBoolOrScriptError @@ -59,6 +60,14 @@ stringOrTypeError _ (NGOString s) = return s stringOrTypeError _ (NGOFilename s) = return (T.pack s) stringOrTypeError context val = throwScriptError ("Expected a string (received " ++ show val ++ ") in context '" ++ context ++ "'") + +-- | If argument represents a file, then return it; otherwise, raise an error +filepathOrTypeError :: (MonadError NGError m) => String -> NGLessObject -> m FilePath +filepathOrTypeError _ (NGOString s) = return (T.unpack s) +filepathOrTypeError _ (NGOFilename s) = return s +filepathOrTypeError _ (NGOSequenceSet fp) = return fp +filepathOrTypeError context val = throwScriptError ("Expected a filepath (received " ++ show val ++ ") in context '" ++ context ++ "'") + -- | If argument is an NGOInteger, then unwraps it; else it raises a type error integerOrTypeError :: (MonadError NGError m) => String -> NGLessObject -> m Integer diff --git a/NGLess/NGLess/NGLEnvironment.hs b/NGLess/NGLess/NGLEnvironment.hs --- a/NGLess/NGLess/NGLEnvironment.hs +++ b/NGLess/NGLess/NGLEnvironment.hs @@ -57,7 +57,8 @@ } parseVersion :: Maybe T.Text -> NGLess NGLVersion -parseVersion Nothing = return $ NGLVersion 1 4 +parseVersion Nothing = return $ NGLVersion 1 5 +parseVersion (Just "1.5") = return $ NGLVersion 1 5 parseVersion (Just "1.4") = return $ NGLVersion 1 4 parseVersion (Just "1.3") = return $ NGLVersion 1 3 parseVersion (Just "1.2") = return $ NGLVersion 1 2 @@ -76,7 +77,7 @@ throwScriptError $ concat ["The NGLess version string at the top of the file should only\ncontain a major and a minor version, separated by a dot.\n\n" ,"You probably meant to write:\n\n" ,"ngless \"" , T.unpack majV, ".", T.unpack minV, "\"\n"] - [_, _] -> throwScriptError $ concat ["Version ", T.unpack v, " is not supported (only versions 1.[0-2] and 0.0/0.5-12 are available in this release)."] + [_, _] -> throwScriptError $ concat ["Version ", T.unpack v, " is not supported (only versions 1.[0-5] and 0.0/0.5-12 are available in this release)."] _ -> throwScriptError $ concat ["Version ", T.unpack v, " could not be understood. The version string should look like \"1.0\" or similar"] ngle :: IORef NGLEnvironment {-# NOINLINE ngle #-} diff --git a/NGLess/Output.hs b/NGLess/Output.hs --- a/NGLess/Output.hs +++ b/NGLess/Output.hs @@ -13,13 +13,14 @@ , outputListLno' , outputFQStatistics , outputMappedSetStatistics - , writeOutputJSImages + , writeOutputJS , writeOutputTSV + , writeOutputTo , outputConfiguration ) where import Text.Printf (printf) -import System.IO (hPutStrLn, hIsTerminalDevice, stdout, stderr) +import System.IO (hPutStrLn, hIsTerminalDevice, stdout, stderr, Handle) import System.IO.Unsafe (unsafePerformIO) import System.IO.SafeWrite (withOutputFile) import Data.Maybe (maybeToList, fromMaybe, isJust) @@ -44,11 +45,6 @@ import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.ByteString.Lazy as BL -import qualified Diagrams.Backend.SVG as D -import qualified Diagrams.TwoD.Size as D -import qualified Diagrams.Prelude as D -import Diagrams.Prelude ((#), (^&), (|||)) - import System.Environment (lookupEnv) @@ -297,29 +293,31 @@ | i `elem` stats = Just (HasStatsInfo i) | otherwise = Nothing -writeOutputJSImages :: FilePath -> FilePath -> T.Text -> NGLessIO () -writeOutputJSImages odir scriptName script = liftIO $ do +writeOutputTo :: Handle -> IO () +writeOutputTo h = do + SavedOutput fullOutput _ _ <- outputReverse <$> readIORef savedOutput + forM_ fullOutput $ \(OutputLine lno ot t' msg) -> do + let tformat = "%a %d-%m-%Y %T" + tstr = formatTime defaultTimeLocale tformat t' + lineStr = if lno > 0 + then printf " Line %s" (show lno) + else "" :: String + hPutStrLn h $ printf "[%s]%s (%s): %s" tstr lineStr (show ot) msg + +writeOutputJS :: FilePath -> FilePath -> T.Text -> NGLessIO () +writeOutputJS odir scriptName script = liftIO $ do SavedOutput fullOutput fqStats mapStats <- outputReverse <$> readIORef savedOutput - fqfiles <- forM (zip [(0::Int)..] fqStats) $ \(ix, q) -> do - let oname = "output"++show ix++".svg" - bpos = perBaseQ q - drawBaseQs (odir oname) bpos - return oname t <- getZonedTime let script' = zip [1..] (T.lines script) sInfo = ScriptInfo (odir "output.js") (show t) (wrapScript script' fqStats (mi_lno <$> mapStats)) withOutputFile (odir "output.js") $ \hout -> - BL.hPutStr hout (BL.concat - ["var output = " - , Aeson.encode $ Aeson.object + BL.hPutStr hout (Aeson.encode $ Aeson.object [ "output" .= fullOutput , "processed" .= sInfo , "fqStats" .= fqStats , "mapStats" .= mapStats , "scriptName" .= scriptName - , "plots" .= fqfiles - ] - ,";\n"]) + ]) -- | Writes QC stats to the given filepaths. @@ -388,92 +386,4 @@ forM_ (nConfSearchPath cfg) $ \p -> outputListLno' DebugOutput ["\t\t", p] - -type Diagram = D.QDiagram D.SVG D.V2 Double D.Any --- Draw a chart of the base qualities --- --- The code is very empirical in magic numbers -drawBaseQs :: FilePath -> [BPosInfo] -> IO () -drawBaseQs oname bpos = D.renderSVG oname (D.mkSizeSpec2D (Just (1200.0 :: Double)) (Just 800.0)) $ - D.padX 1.2 $ D.padY 1.1 $ D.centerXY $ - chart ||| D.strutX 0.04 ||| legend - where - datalines = [ - ("Mean" , style1, meanValues), - ("Median", style2, medianValues), - ("Upper Quartile", style3, uqValues), - ("Lower Quartile", style4, lqValues) - ] - - lenBP = length bpos - chart = mconcat [plot st d | (_, st, d) <- datalines] - <> horizticks <> vertticks - <> text' "Basepair position" # D.moveTo (0.5 ^& (-0.07)) - <> text' "Quality score" # D.rotate (90 D.@@ D.deg) # D.moveTo ((-0.1) ^& (0.5)) - - plot :: (D.Path D.V2 Double, Diagram -> Diagram) -> [(Double, Double)] -> Diagram - plot (shape, style) ps = let - ps' = D.p2 <$> ps - in style (D.strokeP $ D.fromVertices ps') `D.atop` D.strokeP (mconcat [ shape D.# D.moveTo p | p <- ps' ]) - horizticks :: Diagram - horizticks = - let - ticks = (takeWhile (< lenBP) [0, 25..]) ++ [lenBP] - pairs = [(fromIntegral tk * tickspace, show tk) | tk <- ticks] - tickspace :: Double - tickspace = 1.0 / fromIntegral lenBP - - textBits = mconcat [ text' t # D.moveTo ((x)^&(-0.04)) | (x,t) <- pairs ] - tickBits = mconcat [ D.fromVertices [ (x) ^& 0, (x) ^& 0.1 ] | (x,_) <- pairs ] - <> mconcat [ D.fromVertices [ (x) ^& h, (x) ^& (h-0.1) ] | (x,_) <- pairs ] - <> mconcat [ D.fromVertices [ (x) ^& 0, (x) ^& h ] # dashedLine | (x,_) <- pairs ] - in textBits <> tickBits - - h = 1.0 - w = 1.0 - - dashedLine = D.lc D.gray . D.dashing [ 0.3, 0.3] 0 - vertticks :: Diagram - vertticks = - let - pairs = [(0.0, "0"), - (0.25, "10"), - (0.50, "20"), - (0.75, "30"), - (1.00, "40")] - textBits = mconcat [ text' t # D.alignR # D.moveTo ((-0.04) ^& y) | (y,t) <- pairs ] - tickBits = mconcat [ D.fromVertices [ 0 ^& y, 0.1 ^& y ] | (y,_) <- pairs ] - <> mconcat [ D.fromVertices [ w ^& y, (w-0.1) ^& y ] | (y,_) <- pairs ] - <> mconcat [ D.fromVertices [ 0 ^& y, w ^& y ] # dashedLine | (y,_) <- pairs ] - in textBits <> tickBits - - - legend = D.translateY 0.8 $ - D.vcat' D.with {D._sep=0.1} $ - [littleLine s ||| D.strutX 0.2 ||| text' label # D.alignL - | (label, s, _) <- datalines] - where - littleLine :: (D.Path D.V2 Double, Diagram -> Diagram) -> Diagram - littleLine (shape, st) = st (D.strokeP $ D.fromVertices [ D.p2 (0, 0), D.p2 (0.2, 0) ]) <> (D.strokeP shape # D.moveTo (D.p2 (0.1, 0))) - text' :: String -> Diagram - text' s = D.text s # D.fc D.black # D.lw D.none # D.fontSizeL 0.03 - - - [meanValues, medianValues, uqValues, lqValues] = map rescale [_mean, _median, _upperQuartile, _lowerQuartile] - - rescale :: (BPosInfo -> Int) -> [(Double, Double)] - rescale sel = [(rescale1 1 (toInteger lenBP) x, rescale1 0 40 y) | (x,y) <- zip [1..] values] - where - values = map (toInteger . sel) bpos - rescale1 :: Integer -> Integer -> Integer -> Double - rescale1 m0 m1 x = let - m0' = fromInteger m0 - s = fromInteger (m1 - m0) - x' = fromInteger x - in (x'-m0')/s - - style1 = (D.circle 0.01, D.lc D.red) - style2 = (D.square 0.01, D.lc D.green) - style3 = (D.pentagon 0.01, D.lc D.blue) - style4 = (D.star (D.StarSkip 2) (D.pentagon 0.01), D.lc D.brown) diff --git a/NGLess/StandardModules/Parallel.hs b/NGLess/StandardModules/Parallel.hs --- a/NGLess/StandardModules/Parallel.hs +++ b/NGLess/StandardModules/Parallel.hs @@ -44,6 +44,7 @@ import Data.Traversable import Control.Monad.Trans.Class import System.AtomicWrite.Writer.Text (atomicWriteFile) +import System.Random.Shuffle (shuffleM) import Control.Monad.Trans.Resource @@ -71,11 +72,12 @@ import NGLess.NGError import NGLess.NGLEnvironment -import Interpretation.Write (moveOrCopyCompress) +import Interpretation.Write (moveOrCopyCompress, WriteOptions(..)) import Utils.Utils (fmapMaybeM, allSame, moveOrCopy) import Utils.Conduit -import Utils.LockFile +import qualified Utils.LockFile as LockFile +import Utils.LockFile (LockParameters(..)) syncFile :: FilePath -> IO () #ifndef WINDOWS @@ -113,10 +115,18 @@ sanitizePath :: T.Text -> T.Text sanitizePath = T.map (\x -> fromMaybe x (lookup x unsafeCharMap)) -executeLock1 (NGOList entries) kwargs = do - entries' <- mapM (stringOrTypeError "lock1") entries - hash <- lookupStringOrScriptError "lock1" "__hash" kwargs - tag <- lookupStringOrScriptErrorDef (return "") "collect arguments (hidden tag)" "__parallel_tag" kwargs +executeLock1OrForAll funcname (NGOList entries) kwargs = do + let readSetOrTypeError (NGOReadSet name _) = return name + readSetOrTypeError _ = throwShouldNotOccur "Expected a readset" + entries' <- case entries of + [] -> throwDataError "Cannot run on empty list" + (NGOString _:_) -> mapM (stringOrTypeError funcname) entries + (NGOReadSet _ _:_) -> mapM (readSetOrTypeError) entries + _ -> throwScriptError ("Unsupported type for function " ++ funcname) + + hash <- lookupStringOrScriptError funcname "__hash" kwargs + tag <- lookupStringOrScriptErrorDef (return "") "collect arguments (hidden tag)" + (if funcname == "lock1" then "__parallel_tag" else "tag") kwargs let prefix | T.null tag = "" | otherwise = T.unpack tag ++ "-" @@ -125,9 +135,8 @@ -- what file was locked and return the unsanitized name -- See also https://github.com/ngless-toolkit/ngless/issues/68 let saneentries = sanitizePath <$> entries' - lockmap = zip saneentries entries' (e,rk) <- getLock lockdir saneentries - outputListLno' InfoOutput ["lock1: Obtained lock file: '", lockdir T.unpack e ++ ".lock", "'"] + outputListLno' InfoOutput [funcname, ": Obtained lock file: '", lockdir T.unpack e ++ ".lock", "'"] reportbase <- setupHashDirectory prefix "ngless-stats" hash let reportdir = reportbase T.unpack e outputListLno' InfoOutput ["Writing stats to '", reportdir, "'"] @@ -143,11 +152,16 @@ release rk registerFailHook $ do let logfile = lockdir T.unpack e ++ ".failed" - withFile logfile WriteMode $ \h -> - hPutStrLn h "Execution failed" -- TODO output log here - return $! NGOString $ fromMaybe e $ lookup e lockmap + withFile logfile WriteMode $ \h -> do + hPutStrLn h "Execution failed. Execution log:" + writeOutputTo h + case entries of + (NGOString _:_) -> return . NGOString $! fromMaybe e $ lookup e (zip saneentries entries') + _ -> case lookup e (zip saneentries entries) of + Just r -> return r + Nothing -> throwShouldNotOccur "Could not find entry in map (should not happen)" -executeLock1 arg _ = throwScriptError ("Wrong argument for lock1 (expected a list of strings, got `" ++ show arg ++ "`") +executeLock1OrForAll func arg _ = throwScriptError ("Wrong argument for " ++ func ++ " (expected a list of strings, got `" ++ show arg ++ "`") lockName = (++ ".lock") . T.unpack @@ -158,60 +172,91 @@ getLock :: FilePath -- ^ directory where to create locks -> [T.Text] - -- ^ keys to attempt to ock + -- ^ keys to attempt to lock -> NGLessIO (T.Text, ReleaseKey) getLock basedir fs = do existing <- liftIO $ getDirectoryContents basedir let notfinished = flip filter fs $ \fname -> finishedName fname `notElem` existing notlocked = flip filter notfinished $ \fname -> lockName fname `notElem` existing notfailed = flip filter notlocked $ \fname -> failedName fname `notElem` existing + failed = flip filter notfinished $ \fname -> failedName fname `elem` existing + locked = flip filter notfinished $ \fname -> lockName fname `elem` existing + when (null notfinished) $ do + outputListLno' InfoOutput ["All jobs are finished"] + throwError $ NGError NoErrorExit "All jobs are finished" + outputListLno' TraceOutput ["Looking for a lock in '", basedir, "'"] outputListLno' TraceOutput [ - "Looking for a lock in ", basedir, ". ", - "Total number of elements is ", show (length fs), - " (not locked: ", show (length notlocked), "; not finished: ", show (length notfinished), ")."] - -- first try all the elements that are not locked and have not failed - -- if that fails, try the unlocked but failed - -- Finally, try the locked elements in the hope that some may be stale + "Total number of tasks to run is ", show (length fs), + " (total not finished (including locked & failed): ", show (length notfinished), + " ; locked: ", show (length locked), + " ; failed: ", show (length failed), + ")."] + -- first try all the tasks that are not locked and have not failed + -- if that fails, try the locked tasks in the hope that some may be stale + -- Finally, try the unlocked but failed (in random order) getLock' basedir notfailed >>= \case Just v -> return v - Nothing -> getLock' basedir (filter (`notElem` notfailed) notlocked) >>= \case - Just v -> return v - Nothing -> do - outputListLno' TraceOutput ["All elements locked. checking for stale locks"] - getLock' basedir notfinished >>= \case - Just v -> return v - Nothing -> do - let msg = if null (notfailed ++ notfailed) - then "All jobs are finished" - else "Jobs appear to be running" - outputListLno' WarningOutput ["Could get a lock for any file: ", msg] - throwError $ NGError NoErrorExit msg + Nothing -> do + outputListLno' InfoOutput ["All tasks locked or failed. Checking for stale locks..."] + getLock' basedir locked >>= \case + Just v -> return v + Nothing -> do + when (null failed) $ do + outputListLno' InfoOutput ["All jobs appear to be finished or running"] + throwError $ NGError NoErrorExit "All jobs are finished or running" + -- randomizing the order maximizes the possibilities to get a lock + failed' <- liftIO $ shuffleM failed + outputListLno' InfoOutput ["All tasks locked or failed and there are no stale locks."] + outputListLno' InfoOutput ["Will retry some failed tasks, but it is possible that this will fail again."] + outputListLno' InfoOutput ["Failed logs are in directory '", basedir, "'"] + getLock' basedir failed' >>= \case + Just v -> return v + Nothing -> do + let msg + | null (notfailed ++ notfailed) = "All jobs are finished" + | null failed = "Jobs appear to be running" + | otherwise = "Jobs are either locked or failed. Check directory '" ++ basedir ++ "' for more information" + outputListLno' WarningOutput ["Could get a lock for any file: ", msg] + throwError $ NGError NoErrorExit msg getLock' _ [] = return Nothing -getLock' basedir (f:fs) = do - let lockname = basedir lockName f - finished <- liftIO $ doesFileExist (basedir finishedName f) - if finished - then getLock' basedir fs - else acquireLock LockParameters - { lockFname = lockname - , maxAge = fromInteger (60*60) - -- one hour. Given that lock files are touched - -- every ten minutes if things are good (see - -- thread below), this is an indication that - -- the process has crashed - , whenExistsStrategy = IfLockedNothing - , mtimeUpdate = True } >>= \case - Nothing -> getLock' basedir fs - Just rk -> do - return $ Just (f,rk) +getLock' basedir (f:fs) = + LockFile.acquireLock LockFile.LockParameters + { lockFname = basedir lockName f + , maxAge = fromInteger (60*60) + -- one hour. Given that lock files are touched + -- every ten minutes if things are good (see + -- thread below), this is an indication that + -- the process has crashed + , whenExistsStrategy = LockFile.IfLockedNothing + , mtimeUpdate = True } >>= \case + Nothing -> getLock' basedir fs + Just rk -> do + isFinished <- liftIO $ doesFileExist (basedir finishedName f) + if isFinished + then do + release rk + getLock' basedir fs + else return $ Just (f, rk) executeCollect :: NGLessObject -> [(T.Text, NGLessObject)] -> NGLessIO NGLessObject executeCollect (NGOCounts istream) kwargs = do isSubsample <- nConfSubsample <$> nglConfiguration - current <- lookupStringOrScriptError "collect arguments" "current" kwargs - allentries <- lookupStringListOrScriptError "collect arguments" "allneeded" kwargs + current <- case lookup "current" kwargs of + Nothing -> throwScriptError "current not specified in collect call" + Just (NGOString c) -> return c + Just (NGOReadSet n _) -> return n + Just _ -> throwScriptError "current argument (in collect()) must be a string or a readset" + + allentries <- case lookup "allneeded" kwargs of + Nothing -> throwScriptError "collect() called without 'allneeded' argument" + Just (NGOList ells) -> forM ells $ \case + NGOString s -> return s + NGOReadSet n _ -> return n + _ -> throwScriptError "collect() called with 'allneeded' argument, but not all elements are strings or readsets" + Just _ -> throwScriptError "collect() called with 'allneeded' argument that is not a list" + ofile <- lookupStringOrScriptError "collect arguments" "ofile" kwargs hash <- lookupStringOrScriptError "collect arguments" "__hash" kwargs tag <- lookupStringOrScriptErrorDef (return "") "collect arguments (hidden tag)" "__parallel_tag" kwargs @@ -256,7 +301,11 @@ outputListLno' TraceOutput ["Can collect"] newfp <- pasteCounts comment False allentries (map partialfile allentries) outputListLno' TraceOutput ["Pasted. Will move result to ", T.unpack ofile] - moveOrCopyCompress True newfp (T.unpack ofile ++ (if isSubsample then ".subsample" else "")) + moveOrCopyCompress (def + { woCompressLevel = Nothing + , woCanMove = True + , woOFile = T.unpack ofile ++ (if isSubsample then ".subsample" else "") + }) newfp else do outputListLno' TraceOutput ["Cannot collect (not all files present yet), wrote partial file to ", partialfile current] Just lno <- ngleLno <$> nglEnvironment @@ -511,7 +560,7 @@ lock1 = Function { funcName = FuncName "lock1" - , funcArgType = Just (NGList NGLString) + , funcArgType = Just (NGLUnion [NGList NGLString, NGList NGLReadSet]) , funcArgChecks = [] , funcRetType = NGLString , funcKwArgs = [] @@ -519,14 +568,14 @@ , funcChecks = [] } -collectFunction = Function +collectFunction isV11 = Function { funcName = FuncName "collect" , funcArgType = Just NGLCounts , funcArgChecks = [] , funcRetType = NGLVoid , funcKwArgs = - [ArgInformation "current" True NGLString [] - ,ArgInformation "allneeded" True (NGList NGLString) [] + [ArgInformation "current" (not isV11) NGLString [] + ,ArgInformation "allneeded" (not isV11) (NGList NGLString) [] ,ArgInformation "ofile" True NGLString [ArgCheckFileWritable] ,ArgInformation "__can_move" False NGLBool [] ,ArgInformation "comment" False NGLString [] @@ -561,23 +610,94 @@ , funcChecks = [] } -parallelTransform :: [(Int, Expression)] -> NGLessIO [(Int, Expression)] -parallelTransform script = addLockHash (processSetParallelTag script) + +runForAllFunctions = + [ Function + { funcName = FuncName "run_for_all" + , funcArgType = Just (NGList NGLString) + , funcArgChecks = [] + , funcRetType = NGLString + , funcKwArgs = + [ ArgInformation "tag" False NGLString [] + ] + , funcAllowsAutoComprehension = False + , funcChecks = [] + } + , Function + { funcName = FuncName "run_for_all_samples" + , funcArgType = Just (NGList NGLReadSet) + , funcArgChecks = [] + , funcRetType = NGLReadSet + , funcKwArgs = + [ ArgInformation "tag" False NGLString [] + ] + , funcAllowsAutoComprehension = False + , funcChecks = [] + } + ] + + +parallelTransform :: Bool -> [(Int, Expression)] -> NGLessIO [(Int, Expression)] +parallelTransform includeForAll = processRunForAll includeForAll >=> processSetParallelTag >=> addLockHash + addLockHash :: [(Int, Expression)] -> NGLessIO [(Int, Expression)] addLockHash script = pureTransform addLockHash' script where addLockHash' :: Expression -> Expression - addLockHash' (FunctionCall (FuncName "lock1") expr kwargs block) = - FunctionCall (FuncName "lock1") expr ((Variable "__hash", ConstStr h):kwargs) block - where - h = T.pack . MD5.md5s . MD5.Str . show $ map snd script + addLockHash' (FunctionCall fn@(FuncName fname) expr kwargs block) + | fname `elem` ["lock1", "run_for_all", "run_for_all_samples"] = + FunctionCall fn expr ((Variable "__hash", ConstStr h):kwargs) block + where + h = T.pack . MD5.md5s . MD5.Str . show $ map snd script addLockHash' e = e +processRunForAll :: Bool -> [(Int, Expression)] -> NGLessIO [(Int, Expression)] +processRunForAll False = checkNoRunForAll +processRunForAll True = processRunForAll' Nothing -processSetParallelTag :: [(Int, Expression)] -> [(Int, Expression)] -processSetParallelTag = processSetParallelTag' False +processRunForAll' _ [] = return [] +processRunForAll' Nothing ((lno,expr):rest) = case expr of + Assignment v (FunctionCall (FuncName fname) slist kwargs _) + | fname `elem` ["run_for_all", "run_for_all_samples"] -> do + let save_match = Assignment (Variable "$parallel$iterator") (Lookup (Just NGLString) v) + save_list = Assignment (Variable "$parallel$list") slist + set_tag = do + tag <- lookup (Variable "tag") kwargs + return (lno, + FunctionCall (FuncName "set_parallel_tag") tag [] Nothing) + rest' <- processRunForAll' (Just (lno, slist)) rest + let res = ((lno,expr):(lno,save_match):(lno,save_list):rest') + case set_tag of + Nothing -> return res + Just t -> return (t:res) + _ -> do + ((lno,expr):) <$> processRunForAll' Nothing rest +processRunForAll' (Just prev) ((lno,e):rest) = case e of + Assignment _ (FunctionCall (FuncName fname) _ _ _) + | fname `elem` ["run_for_all", "run_for_all_samples"] -> do + throwScriptError ("The functions 'run_for_all'/'run_for_all_samples' can only be called once (seen on lines "++show prev++" and "++show lno++")") + FunctionCall fn@(FuncName "collect") expr kwargs block -> do + let kwargs' = (Variable "allneeded", Lookup (Just NGLString) (Variable "$parallel$list")) + :(Variable "current", Lookup (Just NGLString) (Variable "$parallel$iterator")) + :kwargs + e' = FunctionCall fn expr kwargs' block + rest' <- processRunForAll' (Just prev) rest + return ((lno,e'):rest') + _ -> do + rest' <- processRunForAll' (Just prev) rest + return ((lno,e):rest') + +checkNoRunForAll = mapM checkNoRunForAll1 where + checkNoRunForAll1 (_,Assignment _ (FunctionCall (FuncName fname) _ _ _)) + | fname `elem` ["run_for_all", "run_for_all_samples"] = + throwScriptError ("Function '"++T.unpack fname++"' is only available in parallel module version 1.1+. Please upgrade your import") + checkNoRunForAll1 e = return e + +processSetParallelTag :: [(Int, Expression)] -> NGLessIO [(Int, Expression)] +processSetParallelTag = return . processSetParallelTag' False + where processSetParallelTag' :: Bool -> [(Int, Expression)] -> [(Int, Expression)] processSetParallelTag' _ [] = [] processSetParallelTag' hasTag ((lno, e):rest) = let @@ -594,23 +714,26 @@ loadModule :: T.Text -> NGLessIO Module loadModule v - | v `notElem` ["1.0", "0.6"] = throwScriptError ("The behaviour of the parallel module changed.\n"++ - "Only versions 1.0 & 0.6 is now supported (currently attempting to import version '"++T.unpack v++"')") - | otherwise = + | v `notElem` ["1.1", "1.0", "0.6"] = throwScriptError ("The behaviour of the parallel module changed.\n"++ + "Only versions 1.1/1.0/0.6 are now supported (currently attempting to import version '"++T.unpack v++"')") + | otherwise = do + let includeForAll = v == "1.1" return def - { modInfo = ModInfo "stdlib.parallel" "1.0" - , modFunctions = - [ lock1 - , collectFunction - , setTagFunction - , pasteHiddenFunction - ] - , modTransform = parallelTransform - , runFunction = \case - "lock1" -> executeLock1 - "collect" -> executeCollect - "set_parallel_tag" -> executeSetTag - "__paste" -> executePaste - _ -> error "Bad function name" - } + { modInfo = ModInfo "stdlib.parallel" v + , modFunctions = + [ lock1 + , collectFunction includeForAll + , setTagFunction + , pasteHiddenFunction + ] ++ (if includeForAll then runForAllFunctions else []) + , modTransform = parallelTransform includeForAll + , runFunction = \case + "lock1" -> executeLock1OrForAll "lock1" + "collect" -> executeCollect + "set_parallel_tag" -> executeSetTag + "run_for_all" -> executeLock1OrForAll "run_for_all" + "run_for_all_samples" -> executeLock1OrForAll "run_for_all_samples" + "__paste" -> executePaste + _ -> error "Bad function name" + } diff --git a/NGLess/Tokens.hs b/NGLess/Tokens.hs --- a/NGLess/Tokens.hs +++ b/NGLess/Tokens.hs @@ -1,4 +1,4 @@ -{- Copyright 2013-2021 NGLess Authors +{- Copyright 2013-2022 NGLess Authors - License: MIT -} {-# LANGUAGE FlexibleContexts, CPP #-} @@ -125,7 +125,16 @@ ,"STDOUT" ] -variableStr = (:) <$> (char '_' <|> letter) <*> many (char '_' <|> alphaNum) +variableStrSimple = (:) <$> (char '_' <|> letter) <*> many (char '_' <|> alphaNum) +-- variableStr is `variableStrSimple` or `variableStrSimple`::`variableStrSimple` +variableStr = do + s <- variableStrSimple + let long = try $ do + _ <- string "::" + s' <- variableStrSimple + return $ concat [s, "::", s'] + long <|> return s + operator = TOperator <$> oneOf "=,+-*():[]<>.|" boperator = -- Check for a not-so-unreasonable user mistake diff --git a/NGLess/Types.hs b/NGLess/Types.hs --- a/NGLess/Types.hs +++ b/NGLess/Types.hs @@ -1,4 +1,4 @@ -{- Copyright 2013-2021 NGLess Authors +{- Copyright 2013-2022 NGLess Authors - License: MIT -} {-# LANGUAGE FlexibleContexts #-} @@ -15,12 +15,11 @@ import qualified Data.Map as Map import Control.Arrow import Data.Maybe -import Control.Monad import Control.Monad.State.Strict import Control.Monad.Trans.Except -import Control.Monad.Reader +import Control.Monad.Reader (ReaderT(..), asks) import Control.Monad.Writer -import Control.Applicative +import Control.Applicative ((<|>)) import Data.String (fromString) import Data.List (find, foldl') import Data.Functor (($>)) @@ -327,11 +326,20 @@ checkfunctype NGLAny NGLVoid = errorInLineC ["Function '", show f, "' can take any type, but the input is of illegal type Void."] checkfunctype NGLAny _ = return () + checkfunctype NGLString NGLSequenceSet = return () + checkfunctype (NGLUnion ts) t + | any (`trivialConvertable` t) ts = return () + | otherwise = errorInLineC + ["Function '", show f, "' can take any of ", show ts, " but the input is of illegal type ", show t, "."] checkfunctype t t' - | t /= t' = errorInLineC - ["Bad type in function call (function '", show f,"' expects ", show t, " got ", show t', ")."] - | otherwise = return () + | t' `trivialConvertable` t = return () + | otherwise = errorInLineC + ["Bad type in function call (function '", show f,"' expects ", show t, " got ", show t', ")."] +trivialConvertable :: NGLType -> NGLType -> Bool +trivialConvertable NGLSequenceSet NGLString = True +trivialConvertable t t' = t == t' + checkFuncKwArgs :: FuncName -> [(Variable, Expression)] -> TypeMSt () checkFuncKwArgs f args = do Function _ _ _ _ argInfo _ _ <- funcInfo f @@ -350,10 +358,10 @@ ++ map ((\aname -> "\t"++aname++"\n") . T.unpack . argName) arginfo (_, Nothing) -> return () -- Could not infer type of argument. Maybe an error, but maybe not (Just ainfo', Just t') -> - when (argType ainfo' /= t') $ + unless (t' `trivialConvertable` argType ainfo') $ errorInLineC - ["Bad argument type in ", ferr ,", variable " , show v, ". ", - "Expected ", show . argType $ ainfo', " got ", show t', "."] + ["Bad argument type in ", ferr ,", argument " , show v, " ", + "(expected ", show . argType $ ainfo', " got ", show t', ")."] requireType :: NGLType -> Expression -> TypeMSt NGLType diff --git a/NGLess/Utils/Samtools.hs b/NGLess/Utils/Samtools.hs --- a/NGLess/Utils/Samtools.hs +++ b/NGLess/Utils/Samtools.hs @@ -1,4 +1,4 @@ -{- Copyright 2015-2019 NGLess Authors +{- Copyright 2015-2022 NGLess Authors - License: MIT -} @@ -101,9 +101,7 @@ -- The output is a newly created temporary file convertBamToSam :: FilePath -> NGLessIO FilePath convertBamToSam bamfile = do - (newfp, hout) <- openNGLTempFile bamfile "converted_" "sam" - outputListLno' DebugOutput ["BAM->SAM Conversion start ('", bamfile, "' -> '", newfp, "')"] - C.runConduit $ - samBamConduit bamfile .| C.sinkHandle hout - liftIO $ hClose hout - return newfp + makeNGLTempFile bamfile "converted_" "sam" $ \hout -> do + outputListLno' DebugOutput ["BAM->SAM Conversion start ('", bamfile, "' -> )"] + C.runConduit $ + samBamConduit bamfile .| C.sinkHandle hout diff --git a/NGLess/Utils/Utils.hs b/NGLess/Utils/Utils.hs --- a/NGLess/Utils/Utils.hs +++ b/NGLess/Utils/Utils.hs @@ -23,9 +23,9 @@ import System.IO.Error import Control.Exception import GHC.IO.Exception (IOErrorType(..)) - +import Safe (lookupJustDef) import Data.List (group) -import Data.Maybe (fromMaybe, catMaybes) +import Data.Maybe (catMaybes) #ifdef WINDOWS import System.AtomicWrite.Internal (tempFileFor, closeAndRename) #else @@ -39,7 +39,7 @@ -- | lookup with a default if the key is not present in the association list lookupWithDefault :: Eq b => a -> b -> [(b,a)] -> a -lookupWithDefault def key values = fromMaybe def $ lookup key values +lookupWithDefault = lookupJustDef {-# INLINE lookupWithDefault #-} -- | equivalent to the Unix command 'uniq' diff --git a/NGLess/Version.hs b/NGLess/Version.hs --- a/NGLess/Version.hs +++ b/NGLess/Version.hs @@ -14,13 +14,13 @@ import Paths_NGLess (version) versionStr :: String -versionStr = "1.4.2" +versionStr = showVersion version versionStrLong :: String -versionStrLong = "1.4.2" +versionStrLong = "1.5.0" dateStr :: String -dateStr = "July 21 2022" +dateStr = "14 September 2022" embeddedStr :: String #ifdef NO_EMBED_SAMTOOLS_BWA diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,15 +3,14 @@ ![NGLess logo](NGLess-logo-128x64.png) Ngless is a domain-specific language for NGS (next-generation sequencing data) processing. -[![Build Status](https://travis-ci.com/ngless-toolkit/ngless.svg?branch=master)](https://travis-ci.com/ngless-toolkit/ngless) +[![Build & test](https://github.com/ngless-toolkit/ngless/actions/workflows/build_w_nix.yml/badge.svg)](https://github.com/ngless-toolkit/ngless/actions/workflows/build_w_nix.yml) [![MIT licensed](https://img.shields.io/badge/license-MIT-blue.svg)](https://raw.githubusercontent.com/hyperium/hyper/master/LICENSE) [![Install with Bioconda](https://anaconda.org/bioconda/ngless/badges/installer/conda.svg)](https://anaconda.org/bioconda/ngless) [![Install with Bioconda](https://anaconda.org/bioconda/ngless/badges/downloads.svg)](https://anaconda.org/bioconda/ngless) [![Citation for NGLess](https://img.shields.io/badge/CITATION-DOI%3A10.1186%252Fs40168--019--0684--8-brightgreen.svg)](https://doi.org/10.1186/s40168-019-0684-8) -[![Join the chat at https://gitter.im/ngless-toolkit](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/ngless-toolkit) -For questions and discussions, please use the [ngless mailing +For questions and discussions, please use the [NGLess mailing list](https://groups.google.com/forum/#!forum/ngless). If you are using NGLess, please cite: @@ -25,7 +24,7 @@ ## Example - ngless "1.4" + ngless "1.5" input = fastq(['ctrl1.fq','ctrl2.fq','stim1.fq','stim2.fq']) input = preprocess(input) using |read|: read = read[5:] @@ -56,21 +55,21 @@ Alternatively, a docker container with NGLess is available at [docker hub](https://hub.docker.com/r/nglesstoolkit/ngless): - docker run -v $PWD:/workdir -w /workdir -it nglesstoolkit/ngless:1.4.0 ngless --version + docker run -v $PWD:/workdir -w /workdir -it nglesstoolkit/ngless:1.5.0 ngless --version Adapt the mount flags (``-v``) as needed. ### Linux You can download a [statically linked version of NGless -1.4.0](https://github.com/ngless-toolkit/ngless/releases/download/v1.4.0/NGLess-v1.4.0-Linux-static-full) +1.5.0](https://github.com/ngless-toolkit/ngless/releases/download/v1.5.0/NGLess-v1.5.0-Linux-static-full) This should work across a wide range of Linux versions (please [report](https://github.com/ngless-toolkit/ngless/issues) any issues you encounter): - curl -L -O https://github.com/ngless-toolkit/ngless/releases/download/v1.4.0/NGLess-v1.4.0-Linux-static-full - chmod +x NGLess-v1.4.0-Linux-static-full - ./NGLess-v1.4.0-Linux-static-full + curl -L -O https://github.com/ngless-toolkit/ngless/releases/download/v1.5.0/NGLess-v1.5.0-Linux-static-full + chmod +x NGLess-v1.5.0-Linux-static-full + ./NGLess-v1.5.0-Linux-static-full This downloaded file bundles bwa, samtools and megahit (also statically linked). @@ -131,7 +130,7 @@ - [Frequently Asked Questions (FAQ)](https://ngless.embl.de/faq.html) - [ngless mailing list](https://groups.google.com/forum/#!forum/ngless) - [What's new log](https://ngless.embl.de/whatsnew.html) -- [NGless 1.4.0 Release Documentation](https://ngless.embl.de/whatsnew.html#version-1-4-0) +- [NGless 1.5.0 Release Documentation](https://ngless.embl.de/whatsnew.html#version-1-5-0) ## Authors diff --git a/Tests-Src/Tests.hs b/Tests-Src/Tests.hs --- a/Tests-Src/Tests.hs +++ b/Tests-Src/Tests.hs @@ -49,6 +49,7 @@ import Tests.LoadFQDirectory (tgroup_LoadFQDirectory) import Tests.NGLessAPI (tgroup_NGLessAPI) import Tests.Parse (tgroup_Parse) +import Tests.Samples (tgroup_Samples) import Tests.Select (tgroup_Select) import Tests.Types (tgroup_Types) import Tests.Validation (tgroup_Validation) @@ -63,6 +64,7 @@ test_NGLessAPI = [tgroup_NGLessAPI] test_Vector = [tgroup_Vector] test_IntGroups = [tgroup_IntGroups] +test_Samples = [tgroup_Samples] test_Select = [tgroup_Select] test_Language = [tgroup_Language] test_LoadFqDir = [tgroup_LoadFQDirectory] diff --git a/Tests-Src/Tests/FastQ.hs b/Tests-Src/Tests/FastQ.hs --- a/Tests-Src/Tests/FastQ.hs +++ b/Tests-Src/Tests/FastQ.hs @@ -21,7 +21,7 @@ import Interpretation.FastQ import Interpretation.Substrim -import Tests.Utils +import Tests.Utils (asTempFile) import Data.FastQ import Utils.Here import Utils.Conduit diff --git a/Tests-Src/Tests/Parse.hs b/Tests-Src/Tests/Parse.hs --- a/Tests-Src/Tests/Parse.hs +++ b/Tests-Src/Tests/Parse.hs @@ -147,5 +147,7 @@ case_parse_kwargs = parseBody "unique(reads,maxCopies=2)\n" @?= [FunctionCall (FuncName "unique") (Lookup Nothing (Variable "reads")) [(Variable "maxCopies", ConstInt 2)] Nothing] +case_parse_double_colon = parseBody "module::function(arg)\n" @?= [FunctionCall (FuncName "module::function") (Lookup Nothing (Variable "arg")) [] Nothing] + case_parse_methods_kwargs_only = parseBody "sf.filter(min_identity_pc=90)\n" @?= [MethodCall (MethodName "filter") (Lookup Nothing (Variable "sf")) Nothing [(Variable "min_identity_pc", ConstInt 90)]] diff --git a/Tests-Src/Tests/Samples.hs b/Tests-Src/Tests/Samples.hs new file mode 100644 --- /dev/null +++ b/Tests-Src/Tests/Samples.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes #-} + +{- Copyright 2022 NGLess Authors + - License: MIT + -} +module Tests.Samples + ( tgroup_Samples + ) where + +import Test.Tasty.TH +import Test.Tasty.HUnit +import qualified Data.ByteString as B +import qualified Data.Text as T +import Control.Monad.IO.Class (liftIO) + +import Data.FastQ +import BuiltinModules.Samples +import Language +import Utils.Here +import Tests.Utils (asTempFile, testNGLessIO) + +simpleYaml :: B.ByteString +simpleYaml = [here| +samples: + sample1: + - paired: + - sample/sample1a.1.fq.gz + - sample/sample1a.2.fq.gz + sample2: + - paired: + - sample/sample2a.1.fq.gz + - sample/sample2a.2.fq.gz +|] + +yamlWithBasedir :: B.ByteString +yamlWithBasedir = [here| +basedir: /share/metagenomes +samples: + sample1: + - paired: + - sample/sample1a.1.fq.gz + - sample/sample1a.2.fq.gz + sample2: + - paired: + - /share/data/sample/sample2a.1.fq.gz + - /share/data/sample/sample2a.2.fq.gz +|] + +tgroup_Samples = $(testGroupGenerator) + +getSampleName (NGOReadSet name _) = name + +case_load_samples :: Assertion +case_load_samples = testNGLessIO $ do + simpleYamlF <- asTempFile simpleYaml "yaml" + NGOList samples <- executeLoadSampleList (NGOString $ T.pack simpleYamlF) [] + liftIO $ length samples @?= 2 + liftIO $ (getSampleName $ head samples) @?= "sample1" + liftIO $ (getSampleName $ last samples) @?= "sample2" + NGOReadSet n _ <- executeLoadSample (NGOString $ T.pack simpleYamlF) [("sample", NGOString "sample1")] + liftIO $ n @?= "sample1" + + +case_basedir :: Assertion +case_basedir = do + NGOList samples <- testNGLessIO $ do + simpleYamlF <- asTempFile yamlWithBasedir "yaml" + executeLoadSampleList (NGOString $ T.pack simpleYamlF) [] + let getSamplePaths (NGOReadSet _ (ReadSet [ + (FastQFilePath _ p1 + ,FastQFilePath _ p2)] + [])) = (p1, p2) + getSamplePaths _ = error "should not occur" + length samples @?= 2 + getSamplePaths (head samples) @?= ( + "/share/metagenomes/sample/sample1a.1.fq.gz", + "/share/metagenomes/sample/sample1a.2.fq.gz") + getSamplePaths (last samples) @?= ( + "/share/data/sample/sample2a.1.fq.gz", + "/share/data/sample/sample2a.2.fq.gz")