diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -StockholmAlignment +StockholmAlignment [![Hackage](https://img.shields.io/hackage/v/StockholmAlignment.svg)](https://hackage.haskell.org/package/StockholmAlignment) [![Build Status](https://travis-ci.org/eggzilla/StockholmAlignment.svg?branch=master)](https://travis-ci.org/eggzilla/StockholmAlignment) ==== Libary containing parsing and visualisation functions and datastructures for Stockholm aligmnent format. diff --git a/StockholmAlignment.cabal b/StockholmAlignment.cabal --- a/StockholmAlignment.cabal +++ b/StockholmAlignment.cabal @@ -1,5 +1,5 @@ name: StockholmAlignment -version: 1.0.0 +version: 1.0.1 synopsis: Libary for Stockholm aligmnent format description: Libary containing parsing and visualisation functions and datastructures for Stockholm aligmnent format license: GPL-3 @@ -10,6 +10,7 @@ category: Bioinformatics build-type: Simple cabal-version: >=1.8 +Tested-With: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 extra-source-files: README.md changelog @@ -20,8 +21,8 @@ source-repository this type: git - location: https://github.com/eggzilla/StockholmAlignment/tree/1.0.0 - tag: 1.0.0 + location: https://github.com/eggzilla/StockholmAlignment/tree/1.0.1 + tag: 1.0.1 library -- Modules exported by the library. @@ -34,7 +35,7 @@ ghc-options: -Wall -O2 -fno-warn-unused-do-bind -- Other library packages from which modules are imported. - build-depends: base >=4.5 && <5, parsec>=3.1.9, diagrams-lib, text, vector, ParsecTools, diagrams-cairo, filepath, colour, directory, either-unwrap, SVGFonts >= 1.6 + build-depends: base >=4.5 && <5, parsec>=3.1.9, diagrams-lib>=1.3.1.4, text, vector, ParsecTools, diagrams-cairo>=1.3.1.2, filepath, colour, directory, either-unwrap, SVGFonts >= 1.4 -- Directories containing source files. hs-source-dirs: src diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ -*-change-log-*- +1.0.1 Florian Eggenhofer 14. January 2017 + * Linted code 1.0.0 Florian Eggenhofer 21. December 2016 * Initial release diff --git a/src/Bio/StockholmData.hs b/src/Bio/StockholmData.hs --- a/src/Bio/StockholmData.hs +++ b/src/Bio/StockholmData.hs @@ -9,11 +9,11 @@ { version :: T.Text, --annotations with the same tag are merged fileAnnotations :: [AnnotationEntry], - columnAnnotations :: [AnnotationEntry], - sequenceEntries :: [SequenceEntry] + columnAnnotations :: [AnnotationEntry], + sequenceEntries :: [SequenceEntry] } deriving (Show, Eq) - + data SequenceEntry = SequenceEntry { sequenceId :: T.Text, @@ -31,4 +31,4 @@ deriving (Show, Eq) data StockholmToken = TokFileA{ fTag :: T.Text, fInfo :: T.Text } | TokColA { cTag :: T.Text, cInfo :: T.Text } | TokResA {rId :: T.Text, rTag :: T.Text, rInfo :: T.Text} | TokSeqA {aId :: T.Text, aTag :: T.Text, aInfo :: T.Text} | TokSeq {sId :: T.Text, sSeq :: T.Text} deriving (Show, Eq) - + diff --git a/src/Bio/StockholmDraw.hs b/src/Bio/StockholmDraw.hs --- a/src/Bio/StockholmDraw.hs +++ b/src/Bio/StockholmDraw.hs @@ -12,11 +12,11 @@ extractGapfreeStructure, isGap ) where - + import Diagrams.Prelude import Diagrams.Backend.Cairo import qualified Bio.StockholmData as S -import qualified Data.Text as T +import qualified Data.Text as T import Data.Maybe import qualified Data.Vector as V import Data.List @@ -30,7 +30,7 @@ vectorEntries = V.map makeVectorEntries currentEntries maxEntryLength = V.maximum (V.map (V.length . snd) vectorEntries) maxIdLength = V.maximum (V.map (length . fst) vectorEntries) - letterWidth = (2.0 :: Double) + letterWidth = 2.0 :: Double availableLettersPerRow = maxWidth / letterWidth blocks = makeLetterIntervals entryNumber availableLettersPerRow maxEntryLength colIndicescomparisonNodeLabels = V.zipWith (\a b -> (a,b)) nodeAlignmentColIndices comparisonNodeLabels @@ -44,20 +44,20 @@ bpindicestest1 = basePairIndices regularStructure1 [] 0 sequencegaps = elemIndices '-' regularsequence1 -- convert incomplete basepairs to . - incompleteBasepairs = filter (\(i,j) -> (elem i sequencegaps) || (elem j sequencegaps)) bpindicestest1 + incompleteBasepairs = filter (\(i,j) -> elem i sequencegaps || elem j sequencegaps) bpindicestest1 incompleteIndicesCharacterPairs = concatMap (\(a,b) -> [(a,'.'),(b,'.')]) incompleteBasepairs - completeBPStructure = V.update (V.fromList regularStructure1) (V.fromList incompleteIndicesCharacterPairs) + completeBPStructure = V.update (V.fromList regularStructure1) (V.fromList incompleteIndicesCharacterPairs) -- remove gap character postitions from structure string - gapfreeCompleteStructure = V.filter (\(i,_) -> not (elem i sequencegaps)) (V.indexed completeBPStructure) + gapfreeCompleteStructure = V.filter (\(i,_) -> notElem i sequencegaps) (V.indexed completeBPStructure) entryStructure = map snd (V.toList gapfreeCompleteStructure) - + basePairIndices :: String -> [Int] -> Int -> [(Int,Int)] basePairIndices (x:xs) ys counter | x == '(' = basePairIndices xs (counter:ys) (counter+1) - | x == ')' = [(head ys,counter)] ++ basePairIndices xs (tail ys) (counter+1) - | x == '.' = [] ++ (basePairIndices xs ys (counter+1)) - | otherwise = [] ++ (basePairIndices xs ys (counter+1)) -basePairIndices [] _ _ = [] + | x == ')' = (head ys,counter) : basePairIndices xs (tail ys) (counter+1) + | x == '.' = [] ++ basePairIndices xs ys (counter+1) + | otherwise = [] ++ basePairIndices xs ys (counter+1) +basePairIndices [] _ _ = [] isGap :: Char -> Bool isGap char @@ -68,7 +68,7 @@ | otherwise = False convertToRegularGap :: Char -> Char -convertToRegularGap char +convertToRegularGap char | char == '.' = '-' | char == ' ' = '-' | char == '\n' = '-' @@ -94,8 +94,8 @@ | c == ':' = '.' | c == ',' = '.' | otherwise = c - + nodeToColIndices :: (Int,(Int,V.Vector (Colour Double))) -> (Int,V.Vector (Colour Double)) nodeToColIndices (colIndex,(_,colors)) = (colIndex,colors) @@ -106,19 +106,19 @@ makeFullComparisonColLabel :: V.Vector (Int, V.Vector (Colour Double)) -> Int -> (Int, V.Vector (Colour Double)) makeFullComparisonColLabel sparseComparisonColLabels colIndex = fullComparisonColLabel where availableLabel = V.find (\(a,_)-> colIndex == a) sparseComparisonColLabels - fullComparisonColLabel = if isJust availableLabel then fromJust availableLabel else (colIndex,V.singleton white) + fullComparisonColLabel = fromMaybe (colIndex,V.singleton white) availableLabel drawStockholmRowBlock :: Int -> V.Vector (String, V.Vector Char) -> Int -> V.Vector (Int, V.Vector (Colour Double)) -> ((Int, Int), V.Vector (Int, Int, Int)) -> QDiagram Cairo V2 Double Any drawStockholmRowBlock maxIdLength vectorEntries maxEntryLength comparisonColLabels ((startIndex,endIndex),letterIntervals) = blockSequences - where indices = [startIndex..safeEndIndex] + where indices = [startIndex..safeEndIndex] safeEndIndex = if (endIndex-1) > (maxEntryLength-1) then maxEntryLength-1 else endIndex-1 - indexLine = drawStockholmIndexLine maxIdLength indices comparisonColLabels + indexLine = drawStockholmIndexLine maxIdLength indices comparisonColLabels blockSequences = indexLine === strutY 2.0 === vcat' with { _sep = 2.0 } (V.toList (V.map (drawStockholmEntryLine maxIdLength vectorEntries) letterIntervals)) drawStockholmIndexLine :: Int -> [Int] -> V.Vector (Int, V.Vector (Colour Double)) -> QDiagram Cairo V2 Double Any drawStockholmIndexLine maxIdLength indices comparisonColLabels = indexLine where --entryText = (spacer ++ indexLetters) - spacerLength = (maxIdLength + 3) + spacerLength = maxIdLength + 3 spacer = replicate spacerLength ' ' --indexLetters = map show indices --indexPositions = maximum (map length indices) @@ -142,10 +142,10 @@ drawStockholmEntryLine :: Int -> V.Vector (String, V.Vector Char) -> (Int, Int, Int) -> QDiagram Cairo V2 Double Any drawStockholmEntryLine maxIdLength aln (seqIndex,currentStart,safeLength) = entryDia where entry = aln V.! seqIndex - entryText = (seqId ++ spacer ++ entrySeq) - seqId = fst entry + entryText = seqId ++ spacer ++ entrySeq + seqId = fst entry entrySeq = V.toList (V.slice currentStart safeLength (snd entry)) - spacerLength = (maxIdLength + 3) - length seqId + spacerLength = (maxIdLength + 3) - length seqId spacer = replicate spacerLength ' ' entryDia = hcat (map setAlignmentLetter entryText) @@ -157,11 +157,11 @@ drawStockholmEntry :: Int -> S.SequenceEntry -> QDiagram Cairo V2 Double Any drawStockholmEntry maxIdLength entry = entryDia - where entryText = T.unpack (seqId `T.append` spacer `T.append` (S.entrySequence entry)) - seqId = S.sequenceId entry - spacerLength = (maxIdLength + 3) - T.length seqId + where entryText = T.unpack (seqId `T.append` spacer `T.append` S.entrySequence entry) + seqId = S.sequenceId entry + spacerLength = (maxIdLength + 3) - T.length seqId spacer = T.replicate spacerLength (T.pack " ") - entryDia = hcat (map setAlignmentLetter entryText) + entryDia = hcat (map setAlignmentLetter entryText) setAlignmentLetter :: Char -> QDiagram Cairo V2 Double Any setAlignmentLetter echar = textSVG_ (TextOpts linLibertineFont INSIDE_H KERN False 2.5 2.5) [echar] # fc black # fillRule EvenOdd # lw 0.0 # translate (r2 (negate 0.75, negate 0.75)) <> rect 2 2 # lw 0.0 @@ -172,9 +172,9 @@ makeLetterIntervals seqNumber letterNumberPerRow letterNumber = rowIntervals where --rowVector = V.iterateN rowNumber (1+) 0 rowList = [0..(rowNumber-1)] - rowNumber = ceiling $ (fromIntegral letterNumber) / letterNumberPerRow + rowNumber = ceiling $ fromIntegral letterNumber / letterNumberPerRow rowIntervals = map (setAlignmentInterval (floor letterNumberPerRow) letterNumber seqNumber) rowList - + setAlignmentInterval :: Int -> Int -> Int -> Int -> ((Int,Int),V.Vector (Int,Int,Int)) setAlignmentInterval letterNumberPerRow letterNumber seqNumber rowIndex = ((indexStart,indexEnd),seqLines) where seqVector = V.iterateN seqNumber (1+) 0 @@ -184,8 +184,8 @@ setAlignmentLineInterval :: Int -> Int -> Int -> Int -> (Int,Int,Int) setAlignmentLineInterval letterNumberPerRow letterNumber rowIndex seqIndex = (seqIndex,currentStart,safeLength) where currentStart = rowIndex * letterNumberPerRow - rowLength = letterNumberPerRow - safeLength = if currentStart + rowLength >= letterNumber then (letterNumber - currentStart) else rowLength + rowLength = letterNumberPerRow + safeLength = if currentStart + rowLength >= letterNumber then letterNumber - currentStart else rowLength makeVectorEntries :: S.SequenceEntry -> (String, V.Vector Char) makeVectorEntries entry = (entrySeqId,entrySeq) diff --git a/src/Bio/StockholmFont.hs b/src/Bio/StockholmFont.hs --- a/src/Bio/StockholmFont.hs +++ b/src/Bio/StockholmFont.hs @@ -8,8 +8,8 @@ (linLibertineFont ) where -import Graphics.SVGFonts.ReadFont -import qualified Data.Text as T +import Graphics.SVGFonts.ReadFont +import qualified Data.Text as T linLibertineFontTuple :: (String, Graphics.SVGFonts.ReadFont.PreparedFont Double) linLibertineFontTuple = loadFont' "linLibertine" linLibertineString diff --git a/src/Bio/StockholmParser.hs b/src/Bio/StockholmParser.hs --- a/src/Bio/StockholmParser.hs +++ b/src/Bio/StockholmParser.hs @@ -15,8 +15,8 @@ import Data.Either.Unwrap readExistingStockholm :: String -> IO (Either String [StockholmAlignment]) -readExistingStockholm filePath = do - if null filePath +readExistingStockholm filePath = + if null filePath then return (Left "") else do fileExists <- doesFileExist filePath @@ -29,12 +29,12 @@ else return (Left ("Could not find stockholm alignment file with path:" ++ filePath)) -- | parse -parseStockholm :: [Char] -> Either ParseError [StockholmAlignment] +parseStockholm :: String -> Either ParseError [StockholmAlignment] parseStockholm input = parse genParseStockholms "Stockholm" input -- | parse StockholmAlignment from input filePath readStockholm :: String -> IO (Either ParseError [StockholmAlignment]) -readStockholm filePath = do +readStockholm filePath = do parsedFile <- parseFromFile genParseStockholms filePath CE.evaluate parsedFile @@ -60,8 +60,7 @@ -- | Parse the input as StockholmAlignment datatype genParseToken :: GenParser Char st StockholmToken genParseToken = do - tok <- choice [try genParseTokFileA, try genParseTokColA, try genParseTokResA, try genParseTokSeqA, try genParseTokSeq] - return tok + choice [try genParseTokFileA, try genParseTokColA, try genParseTokResA, try genParseTokSeqA, try genParseTokSeq] genParseTokFileA :: GenParser Char st StockholmToken genParseTokFileA = do @@ -72,8 +71,8 @@ many1 (char ' ') _info <- many1 (noneOf "\n") newline - return $ (TokFileA (T.pack _tag) (T.pack _info)) - + return (TokFileA (T.pack _tag) (T.pack _info)) + genParseTokColA :: GenParser Char st StockholmToken genParseTokColA = do many newline @@ -82,9 +81,9 @@ _tag <- many1 (noneOf " \n") many1 (char ' ') _info <- many1 (noneOf "\n") - newline + newline return $ TokColA (T.pack _tag) (T.pack _info) - + genParseTokResA :: GenParser Char st StockholmToken genParseTokResA = do many newline @@ -94,9 +93,9 @@ many1 (char ' ') _tag <- many1 (noneOf " \n") _info <- many1 (noneOf "\n") - newline + newline return $ TokResA (T.pack _id) (T.pack _tag) (T.pack _info) - + genParseTokSeqA :: GenParser Char st StockholmToken genParseTokSeqA = do many newline @@ -114,7 +113,7 @@ _sid <- many1 (noneOf " \n") many1 (char ' ') _sequence <- many1 (oneOf "ABCDEFGHIJKLMNOPQRSTUVWXYZ-.") - newline + newline return $ TokSeq (T.pack _sid) (T.pack _sequence) tokenToStockholm :: T.Text -> [StockholmToken] -> StockholmAlignment @@ -126,30 +125,30 @@ _seqtoken = filter isSeqTok _token _fileAnnotation = mergeFileToken _fileAtoken _columnAnnotation = mergeColToken _colAtoken - mergedSeqAToken = mergeSeqAToken _seqAtoken + mergedSeqAToken = mergeSeqAToken _seqAtoken mergedRAToken = mergeResAToken _resAtoken _sequenceEntries = buildSeqEntries mergedSeqAToken mergedRAToken _seqtoken -isFileTok :: StockholmToken -> Bool +isFileTok :: StockholmToken -> Bool isFileTok (TokFileA _ _) = True isFileTok _ = False -isColATok :: StockholmToken -> Bool +isColATok :: StockholmToken -> Bool isColATok (TokColA _ _) = True isColATok _ = False -isResATok :: StockholmToken -> Bool -isResATok (TokResA _ _ _) = True +isResATok :: StockholmToken -> Bool +isResATok (TokResA{}) = True isResATok _ = False -isSeqATok :: StockholmToken -> Bool -isSeqATok (TokSeqA _ _ _) = True +isSeqATok :: StockholmToken -> Bool +isSeqATok (TokSeqA{}) = True isSeqATok _ = False -isSeqTok :: StockholmToken -> Bool +isSeqTok :: StockholmToken -> Bool isSeqTok (TokSeq _ _) = True -isSeqTok _ = False - +isSeqTok _ = False + mergeFileToken :: [StockholmToken] -> [AnnotationEntry] mergeFileToken _token = entries where tags = nub (map fTag _token) @@ -210,23 +209,23 @@ buildSeqEntries seqA resA _token= entries where currentId = map sId _token entries = map (buildSeqEntry seqA resA _token) currentId - + buildSeqEntry :: [StockholmToken] -> [StockholmToken] -> [StockholmToken] -> T.Text -> SequenceEntry -buildSeqEntry seqAtok resAtok _token currentId = entry +buildSeqEntry seqAtok resAtok _token currentId = entry where idToken = filter (\t -> sId t == currentId ) _token idSAToken = filter (\t -> aId t == currentId ) seqAtok idRAToken = filter (\t -> rId t == currentId ) resAtok seqA = map buildSAEntry idSAToken - resA = map buildRAEntry idRAToken + resA = map buildRAEntry idRAToken tagInfos = T.concat (map sSeq idToken) entry = SequenceEntry currentId tagInfos seqA resA - + buildSAEntry :: StockholmToken -> AnnotationEntry buildSAEntry tok = AnnotationEntry (aTag tok) (aInfo tok) buildRAEntry :: StockholmToken -> AnnotationEntry buildRAEntry tok = AnnotationEntry (rTag tok) (rInfo tok) - +