NGLess 1.4.2.0 → 1.5.0
raw patch · 29 files changed
+668/−294 lines, 29 filesdep +random-shuffledep −diagrams-coredep −diagrams-libdep −diagrams-svg
Dependencies added: random-shuffle
Dependencies removed: diagrams-core, diagrams-lib, diagrams-svg
Files
- ChangeLog +16/−0
- Execs/Main.hs +27/−11
- NGLess.cabal +8/−13
- NGLess/BuiltinFunctions.hs +11/−4
- NGLess/BuiltinModules/Assemble.hs +2/−2
- NGLess/BuiltinModules/Checks.hs +9/−6
- NGLess/BuiltinModules/LoadDirectory.hs +2/−2
- NGLess/BuiltinModules/ORFFind.hs +2/−2
- NGLess/BuiltinModules/Samples.hs +157/−0
- NGLess/Citations.hs +1/−1
- NGLess/ExternalModules.hs +7/−1
- NGLess/Interpret.hs +6/−2
- NGLess/Interpretation/Map.hs +1/−1
- NGLess/Interpretation/Write.hs +48/−20
- NGLess/Language.hs +3/−2
- NGLess/NGLess.hs +9/−0
- NGLess/NGLess/NGLEnvironment.hs +3/−2
- NGLess/Output.hs +18/−108
- NGLess/StandardModules/Parallel.hs +204/−81
- NGLess/Tokens.hs +11/−2
- NGLess/Types.hs +18/−10
- NGLess/Utils/Samtools.hs +5/−7
- NGLess/Utils/Utils.hs +3/−3
- NGLess/Version.hs +3/−3
- README.md +9/−10
- Tests-Src/Tests.hs +2/−0
- Tests-Src/Tests/FastQ.hs +1/−1
- Tests-Src/Tests/Parse.hs +2/−0
- Tests-Src/Tests/Samples.hs +80/−0
ChangeLog view
@@ -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
Execs/Main.hs view
@@ -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 <expr>@@ -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" ++
NGLess.cabal view
@@ -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
NGLess/BuiltinFunctions.hs view
@@ -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 []
NGLess/BuiltinModules/Assemble.hs view
@@ -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 =
NGLess/BuiltinModules/Checks.hs view
@@ -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
NGLess/BuiltinModules/LoadDirectory.hs view
@@ -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)]
NGLess/BuiltinModules/ORFFind.hs view
@@ -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++"'")
+ NGLess/BuiltinModules/Samples.hs view
@@ -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"+ }
NGLess/Citations.hs view
@@ -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]
NGLess/ExternalModules.hs view
@@ -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) ]
NGLess/Interpret.hs view
@@ -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
NGLess/Interpretation/Map.hs view
@@ -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))
NGLess/Interpretation/Write.hs view
@@ -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.")
NGLess/Language.hs view
@@ -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
NGLess/NGLess.hs view
@@ -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
NGLess/NGLess/NGLEnvironment.hs view
@@ -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 #-}
NGLess/Output.hs view
@@ -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)
NGLess/StandardModules/Parallel.hs view
@@ -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"+ }
NGLess/Tokens.hs view
@@ -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
NGLess/Types.hs view
@@ -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
NGLess/Utils/Samtools.hs view
@@ -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, "' -> <temp>)"]+ C.runConduit $+ samBamConduit bamfile .| C.sinkHandle hout
NGLess/Utils/Utils.hs view
@@ -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'
NGLess/Version.hs view
@@ -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
README.md view
@@ -3,15 +3,14 @@  Ngless is a domain-specific language for NGS (next-generation sequencing data) processing. -[](https://travis-ci.com/ngless-toolkit/ngless)+[](https://github.com/ngless-toolkit/ngless/actions/workflows/build_w_nix.yml) [](https://raw.githubusercontent.com/hyperium/hyper/master/LICENSE) [](https://anaconda.org/bioconda/ngless) [](https://anaconda.org/bioconda/ngless) [](https://doi.org/10.1186/s40168-019-0684-8)-[](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
Tests-Src/Tests.hs view
@@ -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]
Tests-Src/Tests/FastQ.hs view
@@ -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
Tests-Src/Tests/Parse.hs view
@@ -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)]]
+ Tests-Src/Tests/Samples.hs view
@@ -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")