{-# LANGUAGE OverloadedStrings, LambdaCase, RecordWildCards #-}
import Control.Monad
import Control.Concurrent
import Control.Exception (finally)
import Data.Aeson
import Foreign
import Codec.Picture as Juicy
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (unpack)
import qualified Data.Vector as V
import qualified Data.Vector.Storable as SV
import qualified Network.WebSockets as WS
import qualified Data.Map as Map
import Text.Printf
import System.FilePath
import System.Directory
import System.Process

import TestData
import LambdaCube.Linear
import LambdaCube.IR
import LambdaCube.PipelineSchema
import LambdaCube.PipelineSchemaUtil
import LambdaCube.Mesh

import qualified EditorExamplesTest

main :: IO ()
main = do
  putStrLn "listening"
  WS.runServer "192.168.0.12" 9160 application

application pending = do
  conn <- WS.acceptRequest pending
  WS.forkPingThread conn 30
  let disconnect = return ()
      one = 1 :: Int
  flip finally disconnect $ do
    -- receive client info
    decodeStrict <$> WS.receiveData conn >>= \case
      Nothing -> fail "invalid client info"
      Just ci@ClientInfo{..} -> print ci
    -- send pipeline
    (testName,renderJob@RenderJob{..}) <- EditorExamplesTest.getRenderJob -- TODO
    WS.sendTextData conn . encode $ renderJob
    -- get render result: pipeline x scene x frame
    res <- forM pipelines $ \PipelineInfo{..} -> do
      forM (zip [one..] $ V.toList scenes) $ \(sIdx,Scene{..}) ->
        forM [one..length frames] $ \fIdx -> do
          let name = "backend-test-data/" ++ testName ++ "/result/" ++ takeBaseName pipelineName ++ "_scn" ++ printf "%02d" sIdx ++ "_" ++ printf "%02d" fIdx ++ ".png"
          decodeStrict <$> WS.receiveData conn >>= \case
            Nothing -> fail $ name ++ " - invalid RenderJobResult"
            Just (RenderJobError e) -> fail $ name ++ " - render error:\n" ++ e -- TODO: test failed
            Just (RenderJobResult FrameResult{..}) -> do
              createDirectoryIfMissing True (takeDirectory name)
              compareOrSaveImage name =<< toImage frImageWidth frImageHeight . either error id . B64.decode =<< WS.receiveData conn
              --putStrLn $ name ++ "\t" ++ unwords (map showTime . V.toList $ frRenderTimes)
    let differ = or $ concat $ fmap concat res
    putStrLn $ "render job: " ++ if differ then "FAIL" else "OK"
    forever $ threadDelay 1000000

compareOrSaveImage name img@(Image w h pixels) = do
  doesFileExist name >>= \case
    False -> do
      putStrLn $ "new image: " ++ name
      savePngImage name (ImageRGBA8 img)
      return False
    True -> do
      Right (ImageRGBA8 (Image origW origH origPixels)) <- readImage name
      let diffPixels a b = SV.sum $ SV.zipWith (\x y -> (fromIntegral x - fromIntegral y)^2) a b :: Float
          diff = diffPixels pixels origPixels
          threshold = 0
          differ = w /= origW || h /= origH || diff > threshold
      case differ of
        True -> do
          putStrLn $ name ++ " - differ!!! " ++ show diff
          let mismatchImage = dropExtension name ++ "_mismatch.png"
              diffImage = dropExtension name ++ "_diff.png"
          putStrLn $ "save difference: " ++ diffImage
          savePngImage mismatchImage (ImageRGBA8 img)
          (exitCode,out,err) <- readProcessWithExitCode "compare" ["-compose","src",name,mismatchImage,diffImage] ""
          --let res = read . head . words $ out :: Float
          print (out,err)
        False -> putStrLn $ name ++ " OK"
      return differ

toImage :: Int -> Int -> BS.ByteString -> IO (Image PixelRGBA8)
toImage w h buf = do
    fp <- mallocForeignPtrBytes (4*w*h)
    withForeignPtr fp $ \dst -> BS.useAsCStringLen buf $ \(src,i) -> copyBytes dst (castPtr src) i
    return $ Image w h $ SV.unsafeFromForeignPtr fp 0 (w*h)

showTime delta
    | t > 1e-1  = printf "%.3fs" t
    | t > 1e-3  = printf "%.1fms" (t/1e-3)
    | otherwise = printf "%.0fus" (t/1e-6)
  where
    t = realToFrac delta :: Double

{-
  data sets:
    hello
    editor
-}
{-
  features to test:
    blending
    depth test
    culling
    texturing
      uniform texture
      render texture
    multi draw calls into the same framebuffer
-}
-- TODO
{-
  how to pair pipelines with predefined data
  basically: storage - pipelines
    render job:
      gpu data
        scene <--> storage
          frame
-}
{-
  initial test cases:
    - hello - done
    - editor exercises
      TODO
        create storage
        collect pipelines
    - create render job list
-}