{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}
import qualified Data.Attoparsec.Text       as Atto
import qualified Data.ByteString.Char8      as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.List as List
import Data.Either
import Data.ByteString.Unsafe
import Data.Text
import Data.Text.Encoding
import Data.Word
import Foreign.Ptr
import System.IO.Unsafe
import qualified Data.Vector as V
import Control.Monad.State ( State, execState, gets, modify )
import qualified Data.IntMap as IntMap

import Codec.Wavefront.Lexer ( lexer )
import Codec.Wavefront.Object ( WavefrontOBJ, ctxtToWavefrontOBJ, objLocations )
import Codec.Wavefront.Token ( tokenize )

import qualified Graphics.WaveFront.Parse as Parse
import qualified Graphics.WaveFront.Parse.Common as Parse

import Wavefront.Lex
import qualified Data.Wavefront as C
import Wavefront as C

import Criterion.Main
#ifdef WEIGH
import Weigh -- WARNING: weigh is incompatible with profiling. It reports much more allocations with profiling turned on.
#endif

foreign import ccall "&cube_obj" cube_ptr :: Ptr Word8
cube_obj_len :: Int
cube_obj_len = 840

cube_obj :: L.ByteString
cube_obj = L.fromChunks . pure . unsafePerformIO $ do
    unsafePackCStringFinalizer cube_ptr cube_obj_len (return ())
{-# NOINLINE cube_obj #-}

cube_objT :: Text
cube_objT = decodeUtf8 $ L.toStrict cube_obj
{-# NOINLINE cube_objT #-}

countVerticesSabadie :: Text -> Int
countVerticesSabadie ts = V.length vs
 where
    obj = sabadie ts
    vs = either (const V.empty) objLocations obj

countVerticesSundqvist :: Text -> Int
countVerticesSundqvist ts = List.length vs
 where
    obj = sundqvist ts
    vs = either (const []) (List.filter isOBJVertex) obj
    isOBJVertex (Parse.OBJVertex {}) = True
    isOBJVertex _                    = False

countVerticesCrayne :: L.ByteString -> Int
countVerticesCrayne bs = execState (parseOBJ builder (ObjConfig IntMap.empty) bs) 0
 where
    builder = (nullBuilder $ return ())
        { vertex = \_ -> modify succ
        }

countVerticesCrayneFull :: L.ByteString -> Int
countVerticesCrayneFull ts = V.length vs
 where
    obj = C.parse ts
    vs = C.objLocations obj


sabadie :: Text -> Either String WavefrontOBJ
sabadie = fmap (ctxtToWavefrontOBJ . lexer) . tokenize

sundqvist :: Text -> Either String (Parse.OBJ Double Text Integer [])
sundqvist = Atto.parseOnly (Parse.wholeFile Parse.obj)

main :: IO ()
main = do
    print $ countVerticesSabadie cube_objT
    print $ countVerticesSundqvist cube_objT
    print $ countVerticesCrayne cube_obj
    putStrLn $ "---- Benchmarking"
    defaultMain [
          bgroup "count vertices"
                [ bench "crayne" $ whnf countVerticesCrayne cube_obj
                , bench "crayneFull" $ whnf countVerticesCrayneFull cube_obj
                , bench "sabadie"   $ whnf countVerticesSabadie   cube_objT
                , bench "sundqvist" $ whnf countVerticesSundqvist cube_objT
                ]
          ]
#ifdef WEIGH
    Weigh.mainWith $ do
        func "crayne" countVerticesCrayne cube_obj
        func "crayneFull" countVerticesCrayneFull cube_obj
        func "sabadie" countVerticesSabadie cube_objT
        func "sundqvist" countVerticesSundqvist cube_objT
#endif
    return ()