--
-- Shapes are a way of representing secondary structures in a more
-- coarse-grained way.

module Biobase.Structure.Shapes where

-- TODO replace the five functions with one! (not trivial, apparently)

import Data.List (mapAccumL)

import Biobase.RNA
import Biobase.Structure
import Biobase.Structure.DotBracket



-- | given an SSTree, return the shape representation

toShape5 :: SSTree a -> String
toShape5 (SSTree i j _ []) = "[]"
toShape5 (SSTree i j _ xs@(x:y:_)) = "[" ++ concatMap toShape5 xs ++ "]"
toShape5 (SSTree _ _ _ [x]) = toShape5 x
toShape5 (SSExt len _ xs) = concatMap toShape5 xs

toShape4 :: SSTree a -> String
toShape4 (SSTree i j _ []) = "[]"
toShape4 (SSTree i j _ xs@(x:y:_)) = "[" ++ concatMap toShape4 xs ++ "]"
toShape4 (SSTree i j _ [x@(SSTree k l _ _)])
  | i+1<k && j-1>l = "[" ++ toShape4 x ++ "]"
  | otherwise      = toShape4 x
toShape4 (SSTree _ _ _ [x]) = toShape4 x
toShape4 (SSExt len _ xs) = concatMap toShape4 xs

toShape3 :: SSTree a -> String
toShape3 (SSTree i j _ []) = "[]"
toShape3 (SSTree i j _ xs@(x:y:_)) = "[" ++ concatMap toShape3 xs ++ "]"
toShape3 (SSTree i j _ [x@(SSTree k l _ _)])
  | i+1<k || j-1>l = "[" ++ toShape3 x ++ "]"
  | otherwise      = toShape3 x
toShape3 (SSTree _ _ _ [x]) = toShape3 x
toShape3 (SSExt len _ xs) = concatMap toShape3 xs

toShape2 :: SSTree a -> String
toShape2 (SSTree i j _ []) = "[]"
toShape2 (SSTree i j _ xs@(x:y:_)) = "[" ++ concatMap toShape2 xs ++ "]"
toShape2 (SSTree i j _ [x@(SSTree k l _ _)])
  | i+1<k || j-1>l = "[" ++ ['_' | i+1<k] ++ toShape2 x ++ ['_' | j-1>l] ++ "]"
  | otherwise      = toShape2 x
toShape2 (SSTree _ _ _ [x]) = toShape2 x
toShape2 (SSExt len _ xs) = concatMap toShape2 xs

toShape1 :: SSTree a -> String
toShape1 (SSTree i j _ []) = "[]"
toShape1 (SSTree i j _ xs@(x:y:_)) = "[" ++ mkDashes i (j-1) xs ++ "]"
toShape1 (SSTree i j _ [x@(SSTree k l _ _)])
  | i+1<k || j-1>l = "[" ++ ['_' | i+1<k] ++ toShape1 x ++ ['_' | j-1>l] ++ "]"
  | otherwise      = toShape1 x
toShape1 (SSTree _ _ _ [x]) = toShape1 x
toShape1 (SSExt _ _ []) = ""
toShape1 (SSExt len _ xs) = mkDashes 0 (len-1) xs


mkDashes a z xs = (concat . snd $ mapAccumL (\acc t@(SSTree k l _ _) -> (l, ['_' | acc+1<k] ++ toShape1 t)) a xs) ++ ['_' | let (SSTree _ k _ _) = last xs, z > k]

toShape :: Int -> SSTree a -> String
toShape s
  | s==5 = toShape5
  | s==4 = toShape4
  | s==3 = toShape3
  | s==2 = toShape2
  | s==1 = toShape1