StockholmAlignment 1.0.0 → 1.0.1
raw patch · 7 files changed
+69/−67 lines, 7 filesdep ~SVGFontsdep ~diagrams-cairodep ~diagrams-libPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: SVGFonts, diagrams-cairo, diagrams-lib
API changes (from Hackage documentation)
- Bio.StockholmParser: parseStockholm :: [Char] -> Either ParseError [StockholmAlignment]
+ Bio.StockholmParser: parseStockholm :: String -> Either ParseError [StockholmAlignment]
Files
- README.md +1/−1
- StockholmAlignment.cabal +5/−4
- changelog +2/−0
- src/Bio/StockholmData.hs +4/−4
- src/Bio/StockholmDraw.hs +28/−28
- src/Bio/StockholmFont.hs +2/−2
- src/Bio/StockholmParser.hs +27/−28
README.md view
@@ -1,4 +1,4 @@-StockholmAlignment+StockholmAlignment [](https://hackage.haskell.org/package/StockholmAlignment) [](https://travis-ci.org/eggzilla/StockholmAlignment) ==== Libary containing parsing and visualisation functions and datastructures for Stockholm aligmnent format.
StockholmAlignment.cabal view
@@ -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
changelog view
@@ -1,3 +1,5 @@ -*-change-log-*-+1.0.1 Florian Eggenhofer <egg@informatik.uni-freiburg.de> 14. January 2017+ * Linted code 1.0.0 Florian Eggenhofer <egg@informatik.uni-freiburg.de> 21. December 2016 * Initial release
src/Bio/StockholmData.hs view
@@ -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)- +
src/Bio/StockholmDraw.hs view
@@ -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)
src/Bio/StockholmFont.hs view
@@ -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
src/Bio/StockholmParser.hs view
@@ -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) - +