{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Exports the Vienna energy tables as a number of C files (one .c file, a
-- number .h files). For this reason, files are written into a target
-- directory!

module Biobase.Vienna.Export.ViennaC
  ( export
  ) where

import Prelude hiding (pi)
import Text.Printf
import System.Directory
import Data.List.Split
import Data.List
import qualified Data.Map as M
import Data.FileEmbed
import qualified Data.ByteString.Char8 as B

import Biobase.Turner.Tables
import Biobase.Vienna
import Data.PrimitiveArray
import Biobase.RNA

import Biobase.Vienna.Default

(g,h) = turner2004GH



type Directory = FilePath

-- | Export the files required for default values in the ViennaRNA 2.0 C
-- package.

export :: ViennaIntTables -> ViennaIntTables -> Directory -> IO ()
export trnrG trnrH target = mapM_ (\f -> f trnrG trnrH target) [exportC, export11, export21, export22]



-- | Export the main C file

exportC :: ViennaIntTables -> ViennaIntTables -> Directory -> IO ()
exportC trnrG trnrH target = writeFile (target ++ "/energy_par.c") out where
  out = unlines [ B.unpack $(embedFile "templates/cheader") , xs, stck, lps, mms, dngls, tris, tets, hexs,includes]
  xs = unlines
        [ pd "lxc37" $ largeLoop trnrG
        , pi "ML_intern37" $ multiHelix trnrG
        , pi "ML_interndH" $ multiHelix trnrH
        , pi "ML_closing37" $ multiOffset trnrG
        , pi "ML_closingdH" $ multiOffset trnrH
        , pi "ML_BASE37" $ multiNuc trnrG
        , pi "ML_BASEdH" $ multiNuc trnrH
        , pi "MAX_NINIO" $ maxNinio trnrG
        , pi "ninio37" $ ninio trnrG
        , pi "niniodH" $ ninio trnrH
        , pi "TerminalAU37" $ termAU trnrG
        , pi "TerminalAUdH" $ termAU trnrH
        , pi "DuplexInit37" $ intermolecularInit trnrG
        , pi "DuplexInitdH" $ intermolecularInit trnrH
        , pi "TripleC37" 100
        , pi "TripleCdH" 1860
        , pi "MultipleCA37" 30
        , pi "MultipleCAdH" 340
        , pi "MultipleCB37" 160
        , pi "MultipleCBdH" 760
        ]
  stck = unlines
          [ "PUBLIC int stack37[NBPAIRS+1][NBPAIRS+1] ="
          , (block2 8 . toList $ stack trnrG)
          , "PUBLIC int stackdH[NBPAIRS+1][NBPAIRS+1] ="
          , (block2 8 . toList $ stack trnrH)
          ]
  lps = unlines
          [ "PUBLIC int hairpin37[31] = {" ++ (concat . intersperse "," . map printNum . toList $ hairpinL trnrG) ++ "};"
          , "PUBLIC int hairpindH[31] = {" ++ (concat . intersperse "," . map printNum . toList $ hairpinL trnrH) ++ "};"
          , "PUBLIC int bulge37[31] = {" ++ (concat . intersperse "," . map printNum . toList $ bulgeL trnrG) ++ "};"
          , "PUBLIC int bulgedH[31] = {" ++ (concat . intersperse "," . map printNum . toList $ bulgeL trnrH) ++ "};"
          , "PUBLIC int internal_loop37[31] = {" ++ (concat . intersperse "," . map printNum . toList $ iloopL trnrG) ++ "};"
          , "PUBLIC int internal_loopdH[31] = {" ++ (concat . intersperse "," . map printNum . toList $ iloopL trnrH) ++ "};"
          ]
  mms = unlines
          [ writeMM "I" iloopMM trnrG trnrH
          , writeMM "H" hairpinMM trnrG trnrH
          , writeMM "M" multiMM trnrG trnrH
          , writeMM "1nI" iloop1xnMM trnrG trnrH
          , writeMM "23I" iloop2x3MM trnrG trnrH
          , writeMM "Ext" extMM trnrG trnrH
          ]
  dngls = unlines
            [ "PUBLIC int dangle3_37[NBPAIRS+1][5] ="
            , block2 5 . toList $ dangle3 trnrG
            , "PUBLIC int dangle3_dH[NBPAIRS+1][5] ="
            , block2 5 . toList $ dangle3 trnrH
            , "PUBLIC int dangle5_37[NBPAIRS+1][5] ="
            , block2 5 . toList $ dangle5 trnrG
            , "PUBLIC int dangle5_dH[NBPAIRS+1][5] ="
            , block2 5 . toList $ dangle5 trnrH
            ]
  t3 = getLookup 3 trnrG trnrH
  t4 = getLookup 4 trnrG trnrH
  t6 = getLookup 6 trnrG trnrH
  tris = writeTabbed 3 "Triloop" t3
  tets = writeTabbed 4 "Tetraloop" t4
  hexs = writeTabbed 6 "Hexaloop" t6

  includes = unlines $ map ((++ "\"") . ("#include \""++))
    [ "intl11.h"
    , "intl11dH.h"
    , "intl21.h"
    , "intl21dH.h"
    , "intl22.h"
    , "intl22dH.h"
    ]



-- | Export iloops 1x1

export11 :: ViennaIntTables -> ViennaIntTables -> Directory -> IO ()
export11 trnrG trnrH target = writeFile (target ++ "/intl11.h") outG >> writeFile (target ++ "/intl11dH.h") outH where
  outG = unlines
    [ "PUBLIC int int11_37[NBPAIRS+1][NBPAIRS+1][5][5] ="
    , (block4 8 5 5 . toList $ iloop1x1 trnrG)
    ]
  outH = unlines
    [ "PUBLIC int int11_dH[NBPAIRS+1][NBPAIRS+1][5][5] ="
    , (block4 8 5 5 . toList $ iloop1x1 trnrH)
    ]



-- | Export iloops 2x1

export21 :: ViennaIntTables -> ViennaIntTables -> Directory -> IO ()
export21 trnrG trnrH target = writeFile (target ++ "/intl21.h") outG >> writeFile (target ++ "/intl21dH.h") outH where
  outG = unlines
    [ "PUBLIC int int21_37[NBPAIRS+1][NBPAIRS+1][5][5][5] ="
    , (block5 8 5 5 5 . toList $ iloop1x2 trnrG)
    ]
  outH = unlines
    [ "PUBLIC int int21_dH[NBPAIRS+1][NBPAIRS+1][5][5][5] ="
    , (block5 8 5 5 5 . toList $ iloop1x2 trnrH)
    ]



-- | Export iloops 2x2

export22 :: ViennaIntTables -> ViennaIntTables -> Directory -> IO ()
export22 trnrG trnrH target =  writeFile (target ++ "/intl22.h") outG >> writeFile (target ++ "/intl22dH.h") outH where
  outG = unlines
    [ "PUBLIC int int22_37[NBPAIRS+1][NBPAIRS+1][5][5][5][5] ="
    , (block6 8 5 5 5 5 . toList $ iloop2x2 trnrG)
    ]
  outH = unlines
    [ "PUBLIC int int22_dH[NBPAIRS+1][NBPAIRS+1][5][5][5][5] ="
    , (block6 8 5 5 5 5 . toList $ iloop2x2 trnrH)
    ]



-- * Helper functions

writeTabbed (ksize :: Int) key (ns,gs,hs) =  unlines
          [ printf "PUBLIC char %ss[%d] =" key ((ksize+3)*40+1)
          , ns
          , ";"
          ] ++ printf "PUBLIC int %s37[40] = " key ++ gs ++ ";\n"
          ++ printf "PUBLIC int %sdH[40] = " key ++ hs ++ ";\n"

getLookup k trnrG trnrH = (nsF,gs,hs) where
  nsF = concat $ intersperse "\n" $ map ((++ " \"") . ("  \"" ++) . map nucleotideToChar) ns
  ns = filter ((==(k+2)) . length) . M.keys $ hairpinLookup trnrG
  gs = lkup trnrG
  hs = lkup trnrH
  lkup tbl = ("{"++) . (++"}") . concat . intersperse "," $ map (printNum . (hairpinLookup tbl M.!)) ns

writeMM typ fun trnrG trnrH = unlines
          [ printf "PUBLIC int mismatch%s37[NBPAIRS+1][5][5] =" typ
          , block3 5 5 . toList $ fun trnrG
          , printf "PUBLIC int mismatch%sdH[NBPAIRS+1][5][5] =" typ
          , block3 5 5 . toList $ fun trnrH
          ]

block2 s2 xs
  = (++ "};")
  . ("{" ++)
  . concat
  . intersperse "\n,"
  . map ((++ "}") . ("{" ++) . concat . intersperse ",")
  . splitEvery s2
  $ map printNum xs

block3 s2 s3 xs
  = (++ "};")
  . ("{" ++)
  . concat
  . intersperse "\n,"
  . map ((++ "}") . ("{" ++) . concat . intersperse ",")
  . splitEvery s2
  . map ((++ "}\n ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s3
  $ map printNum xs

block4 s2 s3 s4 xs
  = (++ "};")
  . ("{" ++)
  . concat
  . intersperse "\n,"
  . map ((++ "}") . ("{" ++) . concat . intersperse ",")
  . splitEvery s2
  . map ((++ "}\n ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s3
  . map ((++ "}\n  ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s4
  $ map printNum xs

block5 s2 s3 s4 s5 xs
  = (++ "};")
  . ("{" ++)
  . concat
  . intersperse "\n,"
  . map ((++ "}") . ("{" ++) . concat . intersperse ",")
  . splitEvery s2
  . map ((++ "}\n ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s3
  . map ((++ "}\n  ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s4
  . map ((++ "}\n   ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s5
  $ map printNum xs

block6 s2 s3 s4 s5 s6 xs
  = (++ "};")
  . ("{" ++)
  . concat
  . intersperse "\n,"
  . map ((++ "}") . ("{" ++) . concat . intersperse ",")
  . splitEvery s2
  . map ((++ "}\n ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s3
  . map ((++ "}\n  ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s4
  . map ((++ "}\n   ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s5
  . map ((++ "}\n    ") . ("{" ++) . concat . intersperse ",")
  . splitEvery s6
  $ map printNum xs


pd :: String -> Double -> String
pd k v = printf "PUBLIC double %s=%f;" k v

pi :: String -> Int -> String
pi k v = printf "PUBLIC int %s=%d;" k v

printNum :: Int -> String
printNum n
  | n >= maxN = "   INF"
  | otherwise = printf "%6d" n
  where
    maxN = 10000