{-# LANGUAGE ScopedTypeVariables #-}

module Test.Pretty where

import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Language.ECMAScript3.Parser
import Language.ECMAScript3.PrettyPrint
import Language.ECMAScript3.Syntax
import Language.ECMAScript3.Syntax.Arbitrary()
import Language.ECMAScript3.Syntax.Annotations
--import System.Exit
import Language.ECMAScript3.SourceDiff
import Test.QuickCheck
import Data.List
import Data.Generics.Uniplate.Data
import Control.Applicative
import Data.Default.Class
import Data.Data (Data)

tests_pretty :: Test
tests_pretty = testGroup "Pretty-printer tests"
               [testProperty "Parse is the inverse of pretty" prettyParseEquivalence
               ,testProperty "Expressions not safe to print in an Expression Statement" unsafeExprStmtProp]

-- main :: IO ()
-- main = 
--   let qcArgs = Args {maxSuccess = 50
--                     ,maxDiscardRatio = 10
--                     ,maxSize = 10
--                     ,replay = Nothing
--                     ,chatty = False}
--   in quickCheckWithResult qcArgs prettyParseEquivalence >>= \res ->
--   case res of
--     Success {} -> putStrLn "All tests passes"
--     GaveUp {} -> putStrLn "Gave up"
--     Failure {} -> putStrLn "Test failed" >> exitFailure
--     NoExpectedFailure {} -> putStrLn "Unexpected failure" >> exitFailure

prettyParseEquivalence :: JavaScript () -> Property
prettyParseEquivalence orig =
  let aor = adaptAST orig
      pp = show $ prettyPrint aor
  in case parseFromString pp of
    Left e -> 
      let err = "Can't parse pretty-printed code. The error was: " ++ (show e) ++
                "\nThe pretty-printed code in question:\n" ++ pp
      in whenFail (putStrLn err) False
    Right parsed ->
      let eq = (removeAnnotations parsed) == aor
          msg ="The parse of the pretty-printed AST didn't match the original\n"
               ++"Diff:\n" ++ jsDiff aor (reannotate (const ()) parsed)
      in whenFail (putStrLn msg) eq

unsafeExprStmtProp :: Expression () -> Bool
unsafeExprStmtProp e =
  let se = show $ prettyPrint e
      actuallyUnsafe = "{" `isPrefixOf` se || "function" `isPrefixOf` se
      oracleUnsafe = unsafeInExprStmt e
  in  actuallyUnsafe == oracleUnsafe

-- | Adapt the AST to account for (non-critical) discrepancies between
-- the parser and the pretty-printer.
adaptAST :: JavaScript () -> JavaScript ()
adaptAST = adaptTryBlock . flattenListExpr

adaptTryBlock :: JavaScript () -> JavaScript ()
adaptTryBlock = transformBi adaptTryBlock_
   where adaptTryBlock_ s = case s of
           TryStmt a tb mc mf -> TryStmt a (blockerize tb) (blockerizeCC <$> mc)
                                           (blockerize <$> mf)
           _ -> s
         blockerize s = case s of
           BlockStmt _ _ -> s
           _             -> BlockStmt () [s]
         blockerizeCC (CatchClause a id s) = CatchClause a id (blockerize s)

flattenListExpr :: JavaScript () -> JavaScript ()
flattenListExpr = transformBi flattenListExpr_
  where flattenListExpr_ :: Expression () -> Expression ()
        flattenListExpr_ e = case e of
          ListExpr a es -> ListExpr a (concatMap gatherExprs es)
          _ -> e
        gatherExprs e = case e of
          ListExpr a es -> es
          _ -> [e]