{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -F -pgmF htfpp #-}
-- |
-- Module      : Language.Haskell.BuildWrapper.CMDTests
-- Copyright   : (c) JP Moresmau 2013
-- License     : BSD3
-- 
-- Maintainer  : jpmoresmau@gmail.com
-- Stability   : beta
-- Portability : portable
-- 
-- Testing for long running operations
module Language.Haskell.BuildWrapper.CMDLongRunningTests where

import Language.Haskell.BuildWrapper.CMDTests 

import Language.Haskell.BuildWrapper.Base hiding (writeFile,readFile)

import Data.ByteString.Lazy ()
import Data.ByteString.Lazy.Char8()

import Data.Maybe
import Data.List

import System.FilePath


import Test.Framework
import Test.HUnit (Assertion)
import Control.Concurrent (threadDelay)

test_NameDefsInScopeLongRunning :: Assertion
test_NameDefsInScopeLongRunning = do
        let api=cabalAPI
        root<-createTestProject
        synchronize api root False
        configure api root Source        
        let rel="src"</>"Main.hs"
        writeFile (root </> rel) $ unlines [  
                  "module Main where",
                  "import B.D",
                  "main=return $ map id \"toto\"",
                  "data Type1=MkType1_1 Int"
                  ] 
        build api root True Source
        synchronize api root False
        (inp,out,_,_)<-build1lr root rel
        (mtts,ns)<- readResult out :: IO (OpResult (Maybe [NameDef]))
        assertBool (isJust mtts)
        assertBool (not $ notesInError ns)
        let tts=fromJust mtts
        assertBool (NameDef "Main.main" [Function] (Just "IO [Char]") `elem` tts)
        assertBool (NameDef "B.D.fD" [Function] (Just "forall a. a") `elem` tts)
        assertBool (NameDef "Main.Type1" [Type] Nothing `elem` tts)
        assertBool (NameDef "Main.MkType1_1" [Constructor] (Just "Int -> Type1") `elem` tts)
        assertBool (NameDef "GHC.Types.Char" [Type] Nothing `elem` tts)          
        assertBool (NameDef "Main.Type2" [Type] Nothing `notElem` tts)
        threadDelay 1000000
        write api root rel $ unlines [  
                  "module Main where",
                  "import B.D",
                  "main=return $ map id \"toto\"",
                  "data Type1=MkType1_1 Int",
                  "data Type2=MkType2_1 Int"
                  ]
        continue inp
        (mtts2,ns2)<-readResult out :: IO (OpResult (Maybe [NameDef]))  
        assertBool (not $ notesInError ns2)
        assertBool (isJust mtts2)
        let tts2=fromJust mtts2
        assertBool (NameDef "Main.Type1" [Type] Nothing `elem` tts2)
        assertBool (NameDef "Main.Type2" [Type] Nothing `elem` tts2)
        write api root rel $ unlines [  
                  "module Main where",
                  "import B.D",
                  "main=return $ map id \"toto\"",
                  "data Type1=MkType1_1 Int",
                  "data Type2=MkType2_1 Int2"
                  ]
        continue inp
        (_,ns3)<-readResult out :: IO (OpResult (Maybe [NameDef]))  
        assertBool (notesInError ns3)
        threadDelay 1000000
        write api root rel $ unlines [  
                  "module Main where",
                  "import B.D",
                  "main=return $ map id \"toto\"",
                  "data Type1=MkType1_1 Int",
                  "data Type2=MkType2_1 Int"
                  ]
        continue inp
        (mtts4,ns4)<-readResult out :: IO (OpResult (Maybe [NameDef]))  
        assertBool (not $ notesInError ns4)
        assertBool (isJust mtts4)
        let tts4=fromJust mtts4
        assertBool (NameDef "Main.Type1" [Type] Nothing `elem` tts4)
        assertBool (NameDef "Main.Type2" [Type] Nothing `elem` tts4)
        end inp
        
test_EvalLongRunning :: Assertion
test_EvalLongRunning = do
        let api=cabalAPI
        root<-createTestProject
        synchronize api root False
        configure api root Source        
        let rel="src"</>"Main.hs"
        writeFile (root </> rel) $ unlines [  
                  "module Main where",
                  "import B.D",
                  "main=return $ map id \"toto\"",
                  "data Type1=MkType1_1 Int"
                  ] 
        build api root True Source
        synchronize api root False
        (inp,out,_,_)<-build1lr root rel
        (mtts,ns)<- readResult out :: IO (OpResult (Maybe [NameDef]))
        assertBool (isJust mtts)
        assertBool (not $ notesInError ns) 
        evalLR inp "reverse \"toto\"" 
        (s1,_)<- readResult out :: IO (OpResult [EvalResult])
        assertEqual [EvalResult (Just "[GHC.Types.Char]") (Just "\"otot\"") Nothing] s1
        evalLR inp "main" 
        (s2,_)<- readResult out :: IO (OpResult [EvalResult])
        assertEqual [EvalResult (Just "[GHC.Types.Char]") (Just "\"toto\"") Nothing] s2     
        evalLR inp "MkType1_1"
        (s3,_)<- readResult out :: IO (OpResult [EvalResult])
        assertBool $ isPrefixOf "No instance for" $ (\(EvalResult _ _ (Just err))->err) $ head s3     
        threadDelay 1000000
        write api root rel $ unlines [  
                  "module Main where",
                  "import B.D",
                  "main=return $ map id \"titi\"",
                  "data Type1=MkType1_1 Int",
                  "data Type2=MkType2_1 Int"
                  ] 
        continue inp
        readResult out :: IO (OpResult (Maybe [NameDef]))  
        evalLR inp "main" 
        (s4,_)<- readResult out :: IO (OpResult [EvalResult])
        assertEqual [EvalResult (Just "[GHC.Types.Char]") (Just "\"titi\"") Nothing] s4
        end inp     
  
test_EvalTextLongRunning :: Assertion
test_EvalTextLongRunning = do
        let api=cabalAPI
        root<-createTestProject
        let cf=testCabalFile root
        writeFile cf $ unlines ["name: "++testProjectName,
          "version:0.1",
          "cabal-version:  >= 1.8",
          "build-type:     Simple",
          "",
          "library",
          "  hs-source-dirs:  src",
          "  exposed-modules: A",
          "  other-modules:  B.C",
          "  build-depends:  base",
          "",
          "executable BWTest",
          "  hs-source-dirs:  src",
          "  main-is:         Main.hs",
          "  other-modules:  B.D",
          "  build-depends:  base, text",
          "",
          "test-suite BWTest-test",
          "  type:            exitcode-stdio-1.0",
          "  hs-source-dirs:  test",
          "  main-is:         Main.hs",
          "  other-modules:  TestA",
          "  build-depends:  base",
          ""
          ]      
          
        synchronize api root False
        configure api root Source        
        let rel="src"</>"Main.hs"
        writeFile (root </> rel) $ unlines [  
                  "{-# LANGUAGE OverloadedStrings #-}",
                  "module Main where",
                  "import qualified Data.Text as T",
                  "t=T.pack \"test\""
                  ] 
        build api root True Source
        synchronize api root False
        (inp,out,_,_)<-build1lr root rel
        (mtts,ns)<- readResult out :: IO (OpResult (Maybe [NameDef]))
        assertBool (isJust mtts)
        assertBool (not $ notesInError ns) 
        evalLR inp "t" 
        (s1,_)<- readResult out :: IO (OpResult [EvalResult])
        assertEqual [EvalResult (Just "Data.Text.Internal.Text") (Just "\"test\"") Nothing] s1
        evalLR inp "T.breakOnEnd \"/\" \"a/b\"" 
        (s2,_)<- readResult out :: IO (OpResult [EvalResult])
        assertEqual [EvalResult (Just "(Data.Text.Internal.Text, Data.Text.Internal.Text)") (Just "(\"a/\",\"b\")") Nothing] s2
        
        end inp    
      
test_TokenTypesLongRunning :: Assertion
test_TokenTypesLongRunning = do
        let api=cabalAPI
        root<-createTestProject
        synchronize api root False
        configure api root Source        
        let rel="src"</>"Main.hs"
        writeFile (root </> rel) $ unlines [  
                  "module Main where",
                  "import B.D",
                  "main=return $ map id \"toto\"",
                  "data Type1=MkType1_1 Int"
                  ] 
        build api root True Source
        synchronize api root False
        (inp,out,_,_)<-build1lr root rel
        (mtts,ns)<- readResult out :: IO (OpResult (Maybe [NameDef]))
        assertBool (isJust mtts)
        assertBool (not $ notesInError ns) 
        tokenTypesLR inp
        (tts,nsErrors1)<-readResult out ::IO (OpResult [TokenDef])
        assertBool (null nsErrors1)
        assertBool (not $ null tts)
        continue inp
        (mtts2,ns2)<-readResult out :: IO (OpResult (Maybe [NameDef]))  
        assertBool (not $ notesInError ns2)
        assertBool (isJust mtts2)
        end inp
     
test_ThingAtPointLongRunning :: Assertion
test_ThingAtPointLongRunning = do
        let api=cabalAPI
        root<-createTestProject
        synchronize api root False
        configure api root Source        
        let rel="src"</>"Main.hs"
        writeFile (root </> rel) $ unlines [  
                  "module Main where",
                  "import B.D",
                  "main=return $ map id \"toto\"",
                  "data Type1=MkType1_1 Int"
                  ] 
        build api root True Source
        synchronize api root False
        (inp,out,_,_)<-build1lr root rel
        (mtts,ns)<- readResult out :: IO (OpResult (Maybe [NameDef]))
        assertBool (isJust mtts)
        assertBool (not $ notesInError ns) 
        tokenTypesLR inp
        (tts,nsErrors1)<-readResult out ::IO (OpResult [TokenDef])
        assertBool (null nsErrors1)
        assertBool (not $ null tts)
        tapLR inp 3 16
        (tap1,nsErrorsTap)<-readResult out :: IO (OpResult (Maybe ThingAtPoint))
        assertBool (null nsErrorsTap)
        assertBool $ isJust tap1
        assertEqual "map" (tapName $ fromJust tap1)
        continue inp
        (mtts2,ns2)<-readResult out :: IO (OpResult (Maybe [NameDef]))  
        assertBool (not $ notesInError ns2)
        assertBool (isJust mtts2)
        end inp    
        
test_LocalsLongRunning :: Assertion
test_LocalsLongRunning = do
        let api=cabalAPI
        root<-createTestProject
        synchronize api root False
        configure api root Source        
        let rel="src"</>"Main.hs"
        writeFile (root </> rel) $ unlines [  
                  "module Main where",
                  "main=return $ map id \"toto\"",
                  "",
                  "fun1 l1=let",
                  "    l2=reverse \"toto\"",
                  "    in head l2"
                  ] 
        build api root True Source
        synchronize api root False
        (inp,out,_,_)<-build1lr root rel
        (mtts,ns)<- readResult out :: IO (OpResult (Maybe [NameDef]))
        assertBool (isJust mtts)
        assertBool (not $ notesInError ns) 
        localsLR inp 4 1 6 10
        (tap1,nsErrorsTap)<-readResult out :: IO (OpResult [ThingAtPoint])
        assertBool (null nsErrorsTap)
        let namesM=map tapName tap1
        assertBool ("l2" `elem` namesM)
        assertBool ("l1" `elem` namesM)
        continue inp
        (mtts2,ns2)<-readResult out :: IO (OpResult (Maybe [NameDef]))  
        assertBool (not $ notesInError ns2)
        assertBool (isJust mtts2)
        end inp