module Main where
import Control.Monad ((>=>))
import Criterion.Main
import qualified Data.ByteString as BS
import Data.Text (Text)
import Geography.VectorTile
import qualified Geography.VectorTile.Protobuf as R
import Lens.Micro
import Lens.Micro.Platform () -- Instances only.
---
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"
let op' = fromRight $ R.decode op >>= R.tile
ls' = fromRight $ R.decode ls >>= R.tile
pl' = fromRight $ R.decode pl >>= R.tile
rd' = fromRight $ R.decode rd >>= R.tile
defaultMain [ bgroup "Decoding"
[ bgroup "onepoint.mvt" $ decodes op
, bgroup "linestring.mvt" $ decodes ls
, bgroup "polygon.mvt" $ decodes pl
, bgroup "roads.mvt" $ decodes rd
]
, bgroup "Encoding"
[ bgroup "Point" $ encodes op'
, bgroup "LineString" $ encodes ls'
, bgroup "Polygon" $ encodes pl'
, bgroup "Roads" $ encodes rd'
]
, bgroup "Data Access"
[ bgroup "All Layer Names"
[ bench "One Point" $ nf layerNames op
, bench "One LineString" $ nf layerNames ls
, bench "One Polygon" $ nf layerNames pl
, bench "roads.mvt" $ nf layerNames rd
]
]
]
decodes :: BS.ByteString -> [Benchmark]
decodes bs = [ bench "Raw.VectorTile" $ nf R.decode bs
, bench "VectorTile" $ nf (R.decode >=> R.tile) bs
]
encodes :: VectorTile -> [Benchmark]
encodes vt = [ bench "Raw.VectorTile" $ nf R.untile vt
, bench "ByteString" $ nf (R.encode . R.untile) vt
]
layerNames :: BS.ByteString -> [Text]
layerNames mvt = t ^.. layers . each . name
where t = fromRight $ R.decode mvt >>= R.tile
fromRight :: Either a b -> b
fromRight (Right b) = b
fromRight _ = error "`Left` given to fromRight!"