diff --git a/flower.cabal b/flower.cabal --- a/flower.cabal +++ b/flower.cabal @@ -1,5 +1,5 @@ Name: flower -Version: 0.6.1 +Version: 0.6.3 License: GPL Cabal-Version: >= 1.6 Author: Ketil Malde @@ -21,41 +21,39 @@ file. The frecover program ignores these and tries to resync with the file after an invalid region. This was likely a one-time bug in the 454 software, so this program is probably not so useful any more. - . - The Darcs repository is at . HomePage: http://blog.malde.org/index.php/flower/ -Build-Depends: bio >= 0.4.8, base >=3 && <5, array >= 0.1, bytestring >= 0.9.1, binary == 0.4.*, random, cmdargs >= 0.5, containers, mtl +-- Source-Repository: http//malde.org/~ketil/biohaskell/flower Build-Type: Simple Tested-with: GHC==6.8.3, GHC==6.12.1 -- Data-files: README - -Executable: flower -Main-Is: Flower.hs -Other-Modules: Print, Metrics, Options, Fork -Hs-Source-Dirs: src -Ghc-Options: -Wall +Executable flower + Main-Is: Flower.hs + Other-Modules: Print, Metrics, Options, Fork + Hs-Source-Dirs: src + Ghc-Options: -Wall -threaded + Build-Depends: bio >= 0.4.8, base >=3 && <5, array >= 0.1, bytestring >= 0.9.1, binary == 0.4.*, random, cmdargs >= 0.5, containers, mtl -Executable: flowselect -Main-Is: FlowSelect.hs -Other-Modules: Metrics -Hs-Source-Dirs: src -Ghc-Options: -Wall -Extensions: ExistentialQuantification +Executable flowselect + Main-Is: FlowSelect.hs + Other-Modules: Metrics + Hs-Source-Dirs: src + Ghc-Options: -Wall + Extensions: ExistentialQuantification -Executable: frecover -Main-Is: FRecover.hs -Hs-Source-Dirs: src -Ghc-Options: -Wall +Executable frecover + Main-Is: FRecover.hs + Hs-Source-Dirs: src + Ghc-Options: -Wall -Executable: frename -Main-Is: FRename.hs -Hs-Source-Dirs: src -Ghc-Options: -Wall +Executable frename + Main-Is: FRename.hs + Hs-Source-Dirs: src + Ghc-Options: -Wall -Executable: flowt -Main-Is: Flowt.hs -Hs-Source-Dirs: src -Ghc-Options: -Wall -fno-warn-unused-do-bind -Extensions: DeriveDataTypeable +Executable flowt + Main-Is: Flowt.hs + Hs-Source-Dirs: src + Ghc-Options: -Wall -fno-warn-unused-do-bind + Extensions: DeriveDataTypeable diff --git a/src/Flower.hs b/src/Flower.hs --- a/src/Flower.hs +++ b/src/Flower.hs @@ -4,7 +4,7 @@ import Bio.Sequence.SFF import Bio.Sequence.Fasta -import Bio.Sequence.FastQ (hWriteSangerQ) +import Bio.Sequence.FastQ (hWriteSangerQ,hWriteIllumina) -- import Bio.Util (countIO) import Print @@ -36,33 +36,35 @@ main = do opts <- O.getArgs when (null $ O.inputs opts) $ error "Please provide an input file!" - SFF h rs <- readSFF (O.inputs opts) - let acts = case buildActions opts h of - [] -> [dumpText] - as -> as - writeInfo (O.info opts) h - forkAndWait $ map ($ map (mkTrimmer opts) rs) acts - + forkAndWait $ buildActions opts -type Action = [ReadBlock] -> IO () +type Action = IO () type Trimmer = ReadBlock -> ReadBlock -type Info = Maybe FilePath -buildActions :: Opts -> CommonHeader -> [Action] -buildActions o ch = snd $ flip runState [] $ do - on (O.fasta o) (\h -> hWriteFasta h . map rbToSequence) -- todo: add qual! - on (O.fastq o) (\h -> hWriteSangerQ h . map rbToSequence) - on (O.summarize o) (\h -> L1.hPut h . summarize) - on (O.flowgram o) (\h -> L1.hPut h . L1.fromChunks . intersperse (B.pack "\n") . concatMap (showread ch)) - on (O.histogram o) (\h -> hPutStrLn h . showHist . histogram (B.unpack $ flow ch) . map flowgram) +buildActions :: Opts -> [Action] +buildActions o = let + inp = mapM readSFF (O.inputs o) + tr = map (mkTrimmer o) + ch (SFF h _) = h + rs (SFF _ r) = r + in snd $ flip runState [] $ do + on (O.info o) (\h -> mapM_ (hPutStrLn h . getHeader . ch) =<< inp) + on (O.fasta o) (\h -> mapM_ (hWriteFasta h . map rbToSequence . tr . rs) =<< inp) + on (O.fqual o) (\h -> mapM_ (hWriteQual h . map rbToSequence . tr . rs) =<< inp) + on (O.text o) (\h -> mapM_ (hPutStrLn h . dumpText . tr . rs) =<< inp) + on (O.fastq o) (\h -> mapM_ (hWriteSangerQ h . map rbToSequence . tr . rs) =<< inp) + on (O.fastq o) (\h -> mapM_ (hWriteIllumina h . map rbToSequence . tr . rs) =<< inp) + on (O.summarize o) (\h -> mapM_ (L1.hPut h . summarize . tr . rs) =<< inp) + on (O.histogram o) (\h -> mapM_ (\(SFF c r) -> hPutStrLn h . showHist . histogram (B.unpack $ flow c) . map flowgram . tr $ r) =<< inp) + on (O.flowgram o) (\h -> mapM_ (\(SFF c r) -> L1.hPut h . L1.fromChunks . intersperse (B.pack "\n") . concatMap (showread c) $ r) =<< inp) on :: Maybe FilePath -> (Handle -> Action) -> State [Action] () on Nothing _ = return () on (Just f) act = modify $ (:) $ case f of "-" -> act stdout - _ -> \rs -> do h <- openFile f WriteMode - act h rs - hClose h + _ -> do h <- openFile f WriteMode + act h + hClose h mkTrimmer :: Opts -> Trimmer mkTrimmer o = case (O.trimKey o, O.trim o) of @@ -71,16 +73,11 @@ (False,True) -> trim (False,False) -> id -writeInfo :: Info -> CommonHeader -> IO () -writeInfo Nothing = const (return ()) -writeInfo (Just "-") = putStr . getHeader -writeInfo (Just f) = writeFile f . getHeader - -- ------------------------------------------------------------ -- No option - dump as text format -- ------------------------------------------------------------ -dumpText :: [ReadBlock] -> IO () -dumpText rs = putStr . concat . map toText $ rs +dumpText :: [ReadBlock] -> String +dumpText rs = concat . map toText $ rs where toText :: ReadBlock -> String toText r = concat [ gt, B.unpack (read_name rh), nl , maybe "" ((\s->info++s++nl) . formatRN) $ decodeReadName (read_name rh) diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -3,6 +3,8 @@ module Options where import System.Console.CmdArgs +import Control.Monad (when) +import Data.Maybe (isJust) data Opts = Opts { trimKey :: Bool @@ -10,28 +12,41 @@ , summarize :: Maybe FilePath , info :: Maybe FilePath , fasta :: Maybe FilePath + , fqual :: Maybe FilePath , fastq :: Maybe FilePath + , illumina :: Maybe FilePath , flowgram :: Maybe FilePath , histogram :: Maybe FilePath - , inputs :: FilePath + , inputs :: [FilePath] , text :: Maybe FilePath } deriving (Data,Typeable, Show, Eq) +optdef :: Ann +optdef = opt ("-"::String) + opts :: Opts opts = Opts { trimKey = False &= help "Trim only the TCAG key sequence" , trim = False &= help "Trim quality using clipping information" &= name "t" - , summarize = def &= help "Output per sequence summary information" &= typFile - , info = def &= help "Output brief overview of the contents" &= typFile - , fasta = def &= help "Output FASTA-formatted sequences" &= typFile &= name "f" - , fastq = def &= help "Output FastQ-formatted sequence and quality" &= typFile &= name "q" - , flowgram = def &= help "Output flowgram information in tabular form" &= typFile &= name "F" - , histogram = def &= help "Output histogram of flow values" &= typFile &= name "h" - , text = def &= help "Output SFF information as text (default)" &= typFile &= name "T" + , summarize = def &= help "Output per sequence summary information" &= typFile &= optdef + , info = def &= help "Output brief overview of the contents" &= typFile &= optdef + , fasta = def &= help "Output FASTA-formatted sequences" &= typFile &= name "f" &= optdef + , fqual = def &= help "Output phred qualities" &= typFile &= name "q" &= optdef + , fastq = def &= help "Output FastQ-formatted sequence and Sanger quality" &= typFile &= name "Q" &= optdef + , illumina = def &= help "Output FastQ-formatted sequence and Illumina quality" &= typFile &= name "I" &= optdef + , flowgram = def &= help "Output flowgram information in tabular form" &= typFile &= name "F" &= optdef + , histogram = def &= help "Output histogram of flow values" &= typFile &= name "h" &= optdef + , text = def &= help "Output SFF information as text (default)" &= typFile &= name "T" &= optdef , inputs = def &= args &= typFile } &= summary "flower v0.6 - Extract information from SFF files" &= program "flower" getArgs :: IO Opts -getArgs = cmdArgs opts +getArgs = do + o <- cmdArgs opts + -- print o + let outs = filter isJust $ map ($o) [summarize,info,fasta,fqual,fastq,illumina,flowgram,histogram,text] + when ((length $ filter (==Just "-") $ outs) > 1) $ error "If you specify more than one output format, you need to specify output files" + let o' = if null outs then o { text = Just "-" } else o + return o'