{-# LANGUAGE BangPatterns #-}
module Bio.Chain.Alignment.Scoring.Loader where

import           Control.Applicative             ( liftA2 )

class ScoringMatrix a where
    scoring :: a -> Char -> Char -> Int

loadMatrix :: String -> [((Char, Char), Int)]
loadMatrix :: String -> [((Char, Char), Int)]
loadMatrix String
txt = (String -> [((Char, Char), Int)])
-> [String] -> [((Char, Char), Int)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> [((Char, Char), Int)]
lineMap ([String] -> [((Char, Char), Int)])
-> (String -> [String]) -> String -> [((Char, Char), Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) ([String] -> [String]
forall a. [a] -> [a]
tail [String]
txtlns)
    where
    -- Lines of matrix
    txtlns :: [String]
    !txtlns :: [String]
txtlns  = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool)
-> (String -> Bool) -> (String -> Bool) -> String -> Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(||) String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#') (Char -> Bool) -> (String -> Char) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Char
forall a. [a] -> a
head)) (String -> String
strip (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String]
lines String
txt)

    -- Letters of matrix
    letters :: [Char]
    !letters :: String
letters = ((String -> Char) -> [String] -> String
forall a b. (a -> b) -> [a] -> [b]
map String -> Char
forall a. [a] -> a
head ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> [String])
-> ([String] -> String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall a. [a] -> a
head) [String]
txtlns
    
    -- Strip spaces
    strip :: String -> String
    strip :: String -> String
strip = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
    
    -- Map one line to a matrix
    lineMap :: [String] -> [((Char, Char), Int)]
    lineMap :: [String] -> [((Char, Char), Int)]
lineMap []       = []
    lineMap (String
x : [String]
xs) =
        let !hx :: Char
hx = String -> Char
forall a. [a] -> a
head String
x
            g :: (Int, Char) -> ((Char, Char), Int)
g (Int
n, Char
c) = ((Char
hx, Char
c), Int
n)
        in  (Int, Char) -> ((Char, Char), Int)
g ((Int, Char) -> ((Char, Char), Int))
-> [(Int, Char)] -> [((Char, Char), Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> [String] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
xs) [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` String
letters