{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
module RlangQQ.Internal where

import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Tree
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import qualified Data.Foldable as F
import System.Directory
import System.Process
import Text.Printf
import Text.Trifecta

import Data.ByteString.Lazy.UTF8 as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as B8


import Paths_Rlang_QQ

{- | Calls R with the supplied string. Variables in R prefixed hs_ cause
the corresponding (un-prefixed) variable to be converted. The variable(s) must
be in the class 'ToRVal'.

For example, when this file <http://code.haskell.org/~aavogt/examples/test.hs> is run

> {-# LANGUAGE QuasiQuotes #-}
> import RlangQQ
>
> x = [0 .. 10  :: Double]
> y = map (sin . (*pi) . (/10)) x
>
> main = do
>   [r|
>     library(ggplot2)
>     png(file='test.png')
>     plot(qplot( hs_x, hs_y ))
>     dev.off()
>     |]

The file is produced <<http://code.haskell.org/~aavogt/Rlang-QQ/examples/test.png>>

-}
r = QuasiQuoter { quoteExp = quoteRExpression 1 }

quoteRExpression i str = do
    let rawFile = printf "Rtmp/raw%d.R" (i::Int) :: String
    let hdrFile = printf "Rtmp/new%d.R" (i::Int) :: String

    variablesToInput <- runIO $ do
        t <- getDataFileName "Tree.R"
        createDirectoryIfMissing False "Rtmp"
        writeFile rawFile str
        rt <- readProcess "R" ["--no-save","--quiet"]
            $ printf "source('%s'); rlangQQ_toTree(parse('%s'))" t rawFile
        case parseString parseTree mempty rt of
            Success a -> return $ hsVars a
            Failure a -> do
                print a
                error "parse failure"
    let varFiles = map (stringE . printf "Rtmp/%d_hs_%s" i) variablesToInput

        writeVarFiles = [|
            mapM_ (\(file,varName, value) -> B.writeFile file (toRVal varName value))  $
                $(listE $ zipWith3 (\x y z -> [| ($x, $y, $z) |])
                            varFiles
                            (map (stringE . ("hs_"++)) variablesToInput)
                            (map (varE . mkName) variablesToInput))

                |]

        runR = [| readProcess "R" ["--no-save", "--quiet"]
                    $ concat
                    $ map (printf "source('%s');") $(listE varFiles)
                     ++ [ printf "source('%s')" rawFile] |]
    [| do
        writeFile hdrFile $ concatMap (printf "source('%s');") variablesToInput
        $writeVarFiles
        $runR
        |]




-- * converting R\'s AST

parseTree' =  do
    symbol "Node"
    nl <- stringLiteral'
    children <- brackets $ commaSep parseTree'
    return (Node nl children)

parseTree = do
    manyTill anyChar (try (string "[1]"))
    manyTill (noneOf "\n") space
    between (oneOf "\"") (oneOf "\"") parseTree'


parseTreeTest = do
    t <- getDataFileName "Tree.R"
    inputFile <- getDataFileName "parseTreeExample.R"
    rt <- readProcess "R" ["--no-save","--quiet"] $ "source('"++ t ++ "'); rlangQQ_toTree(parse('"++ inputFile ++ "'))"
    print rt
    let r = parseString parseTree mempty rt :: Result (Tree String)

    print (fmap hsVars r)

-- | gets variables like @abc@ provided the R file contained @hs_abc@
hsVars :: Tree String -> [String]
hsVars =  mapMaybe (stripPrefix "hs_") . F.toList



-- * classes for marshalling data


-- ** haskell -> R
class ToRVal a where
    toRVal :: String -- ^ variable name
            -> a
            -> B.ByteString

instance ToRVal Int where toRVal x n = B.fromString $ x ++ "<-" ++ show n
instance ToRVal Integer where toRVal x n = B.fromString $ x ++ "<-" ++ show n
instance ToRVal Double where toRVal x n = B.fromString $ x ++ "<-" ++ show n
instance ToRVal String where toRVal x n = B.fromString $ x ++ "<-" ++ show n
instance ToRVal [Int] where toRVal = listToVec
instance ToRVal [Integer] where toRVal = listToVec
instance ToRVal [Double] where toRVal = listToVec
instance ToRVal [String] where toRVal = listToVec

listToVec x n = B8.unwords $
    [B.fromString x,
     B.fromString "<- c(",
        B8.intercalate (B.fromString ",") (map (B.fromString . show) n),
            B.fromString ")"]

-- ** R -> haskell

-- | not used yet
class FromRVal a where fromRVal :: B.ByteString -> a
instance FromRVal Double where fromRVal = fromRValp double


fromRValp p s =
    case parseByteString p mempty (B.toStrict s) of
                Success a -> a
                Failure a -> error (show a)