{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TypeApplications #-}

module Main where

import qualified Data.ByteString as BS
import           Data.Hex
import           Data.ProtocolBuffers hiding (decode)
import           Data.Serialize.Get
import           Data.Serialize.Put
import qualified Geography.VectorTile.Protobuf.Internal as R
import           Test.Tasty
import           Test.Tasty.HUnit
import           Geography.VectorTile
import           Geography.VectorTile.Geometry
import qualified Data.Vector.Unboxed as U

---

main :: IO ()
main = do
  op <- BS.readFile "test/onepoint.mvt"
  ls <- BS.readFile "test/linestring.mvt"
  pl <- BS.readFile "test/polygon.mvt"
  rd <- BS.readFile "test/roads.mvt"
  cl <- BS.readFile "test/clearlake.mvt"
  defaultMain $ suite op ls pl rd cl

{- SUITES -}

suite :: BS.ByteString -> BS.ByteString -> BS.ByteString -> BS.ByteString -> BS.ByteString -> TestTree
suite op ls pl rd cl = testGroup "Unit Tests"
  [ testGroup "Protobuf"
    [ testGroup "Decoding"
      [ testCase "onepoint.mvt -> Raw.Tile" $ testOnePoint op
      , testCase "linestring.mvt -> Raw.Tile" $ testLineString ls
      , testCase "polygon.mvt -> Raw.Tile" $ testPolygon pl
      , testCase "roads.mvt -> Raw.Tile" $ testDecode rd
      , testCase "clearlake.mvt -> Raw.Tile" $ testDecode cl
      , testCase "onepoint.mvt -> VectorTile" $ tileDecode op
      , testCase "linestring.mvt -> VectorTile" $ tileDecode ls
      , testCase "polygon.mvt -> VectorTile" $ tileDecode pl
      , testCase "roads.mvt -> VectorTile" $ tileDecode rd
      , testCase "clearlake.mvt -> VectorTile" $ tileDecode cl
      ]
    , testGroup "Encoding"
      [ testGroup "RawVectorTile <-> VectorTile"
        [ testCase "One Point" $ encodeIso onePoint
        , testCase "One LineString" $ encodeIso oneLineString
        , testCase "One Polygon" $ encodeIso onePolygon
        , testCase "roads.mvt" . encodeIso . fromRight $ decode rd
        ]
      ]
    , testGroup "Serialization Isomorphism"
      [ --testCase "onepoint.mvt <-> Raw.Tile" $ fromRaw op
--      , testCase "linestring.mvt <-> Raw.Tile" $ fromRaw ls
--      , testCase "polygon.mvt <-> Raw.Tile" $ fromRaw pl
      --    , testCase "roads.mvt <-> Raw.Tile" $ fromRaw rd
      testCase "testTile <-> protobuf bytes" testTileIso
      ]
    ]
  , testGroup "Geometries"
    [ testCase "Z-encoding Isomorphism" zencoding
    , testCase "Command Parsing" commandTest
    , testCase "[Word32] <-> [Command]" commandIso
    , testCase "[Word32] <-> V.Vector Point" pointIso
    , testCase "[Word32] <-> V.Vector LineString" linestringIso
    , testCase "[Word32] <-> V.Vector Polygon (2 solid)" polygonIso
    , testCase "[Word32] <-> V.Vector Polygon (1 holed)" polygonIso2
    , testCase "[Word32] <-> V.Vector Polygon (1 holed, 1 solid)" polygonIso3
    ]
  ]

testOnePoint :: BS.ByteString -> Assertion
testOnePoint vt = case decodeIt vt of
                    Left e -> assertFailure e
                    Right t -> t @?= onePoint

testLineString :: BS.ByteString -> Assertion
testLineString vt = case decodeIt vt of
                      Left e -> assertFailure e
                      Right t -> t @?= oneLineString

testPolygon :: BS.ByteString -> Assertion
testPolygon vt = case decodeIt vt of
                   Left e -> assertFailure e
                   Right t -> t @?= onePolygon

-- | For testing is decoding succeeded in generally. Makes no guarantee
-- about the quality of the content, only that the parse succeeded.
testDecode :: BS.ByteString -> Assertion
testDecode = assert . isRight . decodeIt

tileDecode :: BS.ByteString -> Assertion
tileDecode bs = case decodeIt bs of
  Left e -> assertFailure e
  Right t -> assert . isRight $ R.fromProtobuf t

fromRaw :: BS.ByteString -> Assertion
fromRaw vt = case decodeIt vt of
               Left e -> assertFailure e
               Right l -> hex (encodeIt l) @?= hex vt
--               Right l -> if runPut (encodeMessage l) == vt
--                          then assert True
--                          else assertString "Isomorphism failed."

testTileIso :: Assertion
testTileIso = case decodeIt pb of
                 Right tl -> assertEqual "" tl testTile
                 Left e -> assertFailure e
  where pb = encodeIt testTile

decodeIt :: BS.ByteString -> Either String R.RawVectorTile
decodeIt = runGet decodeMessage

encodeIt :: R.RawVectorTile -> BS.ByteString
encodeIt = runPut . encodeMessage

isRight :: Either a b -> Bool
isRight (Right _) = True
isRight _ = False

fromRight :: Either a b -> b
fromRight (Right b) = b
fromRight _ = error "`Left` given to fromRight!"

rawTest :: IO (Either String R.RawVectorTile)
rawTest = decodeIt <$> BS.readFile "onepoint.mvt"

encodeIso :: R.RawVectorTile -> Assertion
encodeIso vt = assert . isRight . fmap R.toProtobuf $ R.fromProtobuf vt

testTile :: R.RawVectorTile
testTile = R.RawVectorTile $ putField [l]
  where l = R.RawLayer { R._version = putField 2
                       , R._name = putField "testlayer"
                       , R._features = putField [f]
                       , R._keys = putField ["somekey"]
                       , R._values = putField [v]
                       , R._extent = putField $ Just 4096
                       }
        f = R.RawFeature { R._featureId = putField $ Just 0
                         , R._tags = putField [0,0]
                         , R._geom = putField $ Just R.Point
                         , R._geometries = putField [9, 50, 34]  -- MoveTo(+25,+17)
                         }
        v = R.RawVal { R._string = putField $ Just "Some Value"
                     , R._float = putField Nothing
                     , R._double = putField Nothing
                     , R._int64 = putField Nothing
                     , R._uint64 = putField Nothing
                     , R._sint = putField Nothing
                     , R._bool = putField Nothing
                     }

-- | Correct decoding of `onepoint.mvt`
onePoint :: R.RawVectorTile
onePoint = R.RawVectorTile $ putField [l]
  where l = R.RawLayer { R._version = putField 1
                       , R._name = putField "OnePoint"
                       , R._features = putField [f]
                       , R._keys = putField []
                       , R._values = putField []
                       , R._extent = putField $ Just 4096
                       }
        f = R.RawFeature { R._featureId = putField Nothing
                         , R._tags = putField []
                         , R._geom = putField $ Just R.Point
                         , R._geometries = putField [9, 10, 10]  -- MoveTo(+5,+5)
                         }

-- | Correct decoding of `linestring.mvt`
oneLineString :: R.RawVectorTile
oneLineString = R.RawVectorTile $ putField [l]
  where l = R.RawLayer { R._version = putField 1
                       , R._name = putField "OneLineString"
                       , R._features = putField [f]
                       , R._keys = putField []
                       , R._values = putField []
                       , R._extent = putField $ Just 4096
                       }
        f = R.RawFeature { R._featureId = putField Nothing
                         , R._tags = putField []
                         , R._geom = putField $ Just R.LineString
                         -- MoveTo(+5,+5), LineTo(+1195,+1195)
                         , R._geometries = putField [9, 10, 10, 10, 2390, 2390]
                         }

-- | Correct decoding of `polygon.mvt`
onePolygon :: R.RawVectorTile
onePolygon = R.RawVectorTile $ putField [l]
  where l = R.RawLayer { R._version = putField 1
                       , R._name = putField "OnePolygon"
                       , R._features = putField [f]
                       , R._keys = putField []
                       , R._values = putField []
                       , R._extent = putField $ Just 4096
                       }
        f = R.RawFeature { R._featureId = putField Nothing
                         , R._tags = putField []
                         , R._geom = putField $ Just R.Polygon
                         -- MoveTo(+2,+2), LineTo(+3,+2), LineTo(-3,+2), ClosePath
                         , R._geometries = putField [9, 4, 4, 18, 6, 4, 5, 4, 15]
                         }

zencoding :: Assertion
zencoding = assert $ map (R.unzig . R.zig) vs @?= vs
  where vs = [0,(-1),1,(-2),2,(-3),3,2147483647,(-2147483648)]

commandTest :: Assertion
commandTest = assert $ R.commands [9,4,4,18,6,4,5,4,15] @?= Right
  [ R.MoveTo $ U.singleton (2,2)
  , R.LineTo $ U.fromList [(3,2),(-3,2)]
  , R.ClosePath ]

commandIso :: Assertion
commandIso = assert $ (R.uncommands . fromRight $ R.commands cs) @?= cs
  where cs = [9,4,4,18,6,4,5,4,15]

pointIso :: Assertion
pointIso = cs' @?= cs
  where cs = [25,4,4,6,6,3,3]
        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @Point)

linestringIso :: Assertion
linestringIso = cs' @?= cs
  where cs = [9,4,4,18,6,4,5,4,9,4,4,18,6,4,5,4]
        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @LineString)

-- | Two solids
polygonIso :: Assertion
polygonIso = cs' @?= cs
  where cs = [9,4,4,18,6,4,5,4,15,9,4,4,18,6,4,5,4,15]
        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @Polygon)

-- | One holed
polygonIso2 :: Assertion
polygonIso2 = cs' @?= cs
  where cs = [9,4,4,26,6,0,0,6,5,0,15,9,2,3,26,0,2,2,0,0,1,15]
        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @Polygon)

-- | One Holed, one solid
polygonIso3 :: Assertion
polygonIso3 = cs' @?= cs
  where cs = [ 9, 4, 4, 26, 6, 0, 0, 6, 5, 0, 15, 9, 2, 3, 26, 0, 2, 2, 0, 0, 1, 15
             , 9, 4, 4, 26, 6, 0, 0, 6, 5, 0, 15 ]
        cs' = fromRight $ R.uncommands . R.toCommands <$> (R.commands cs >>= R.fromCommands @Polygon)

{-}
foo :: FilePath -> IO (Either Text VectorTile)
foo bs = do
  mvt <- BS.readFile bs
  pure $ R.decode mvt >>= tile

-- fmap (V.length . layers <$>) $ foo "roads.mvt"
-}