content: {-# language LambdaCase #-}
  {-# language OverloadedStrings #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Copyright   :  (c) Edward Kmett 2017-2018
  -- License     :  BSD-2-Clause OR Apache-2.0
  -- Maintainer  :  Edward Kmett <ekmett@gmail.com>
  -- Stability   :  experimental
  -- Portability :  non-portable
  --
  -----------------------------------------------------------------------------
  
  module MessageTest
    ( test_message
    ) where
  
  import Control.Lens ((<&>))
  import Data.Aeson (ToJSON, FromJSON, Value(..), fromJSON, toJSON, Result(..))
  import Data.ByteString.Builder
  import Data.Tagged
  import System.FilePath
  import System.IO
  import Test.Tasty
  import Test.Tasty.Golden
  import Test.Tasty.HUnit
  import Test.Tasty.Providers as Tasty
  
  import Paths_coda (getDataDir)
  import Language.Server.Parser
  import Language.Server.Builder
  import Language.Server.Protocol
  
  
  goldenFile :: TestName -> FilePath
  goldenFile name = "test" </> "data" </> name <.> "golden"
  
  newtype ParseTest = ParseTest (IO Tasty.Result)
  instance IsTest ParseTest where
    run _ (ParseTest r) _ = r
    testOptions = Tagged []
  
  -- | perform a golden file test and round-trip test
  golden :: (ToJSON a, FromJSON a, Show a, Eq a) => TestName -> a -> TestTree
  golden name content
    = testGroup name
    [ goldenVsString "encoding" (goldenFile name) $
        pure $ toLazyByteString $ buildMessage content
    , singleTest "parser" $ ParseTest $ do
        dd <- getDataDir
        withFile (dd </> goldenFile name) ReadMode $ \handle ->
          parse eitherDecodeMessage' handle >>= \case
            Left e         -> pure $ testFailed $ "bad JSON-RPC frame: " ++ e
            Right (Left e) -> pure $ testFailed $ "bad JSON message: " ++ e
            Right (Right content')
              | content' /= content -> pure $ testFailed "content mismatch"
              | otherwise -> hIsEOF handle <&> \fin -> if fin
                then testPassed ""
                else testFailed "leftover content"
    , testCase "value" $ fromJSON (toJSON content) @=? Success content
    ]
  
  test_message :: TestTree
  test_message = testGroup "message"
    [ golden "request" $ Request (Just (IntId 1)) "request" Nothing
    , golden "response" $ Response (Just "id") (Just (Number 2)) Nothing
    ]
  