OverlapGraphs.hs

import qualified Bioinformatics.DNANucleotide as D
import qualified Bioinformatics.FASTA as F
import qualified Data.Maybe as MB
import qualified Data.Map as M
import qualified Data.List as L
import Control.Applicative

getLines contents = do
  line <- getLine
  if null line
    then return contents
    else getLines $ contents ++ line ++ "\n"

lastN' n xs = L.foldl' (const . drop 1) xs (drop n xs)

type DNAMap = M.Map [D.DNANucleotide] [String]

buildMaps :: [F.FASTAFormatLine D.DNANucleotide] -> (DNAMap, DNAMap)
buildMaps fls =
  let pres = M.fromListWith (++) $ map (\fl -> (take 3 $ F.content fl, [F.name fl])) fls
      suffs = M.fromListWith (++) $ map (\fl -> (lastN' 3 $ F.content fl, [F.name fl])) fls
  in (pres, suffs)

buildMapJoins :: (DNAMap, DNAMap) -> [([String], Maybe [String])]
buildMapJoins (preM, sufM) =
  M.foldlWithKey (\acc k v -> (v, M.lookup k sufM):acc) [] preM

buildFilteredMapJoins :: Eq a => [([a], Maybe [a])] -> [([a], [a])]
buildFilteredMapJoins mjs =
  filter (\(x, _) -> x /= []) . map (\(xs, Just ys) -> (filter (\x -> not $ L.elem x ys) xs, ys)) $ filter (\(_, ss) -> MB.isJust ss) mjs

buildCombinations :: [([String], [String])] -> [String]
buildCombinations xs = concat $ map (\(ps, ss) -> (++) <$> ( (++) <$> ss <*> [" "] ) <*> ps) xs

main = do
  theLines <- getLines ""
  mapM_ putStrLn . buildCombinations . buildFilteredMapJoins . buildMapJoins . buildMaps . tail $ F.buildFASTALines theLines