content: module Test.Asdf.FileSpec where
  
  import Data.Binary.Get
  import Data.Binary.Put
  import Data.ByteString (ByteString)
  import Data.ByteString qualified as BS
  import Data.ByteString.Lazy qualified as BL
  import Effectful
  import Effectful.NonDet
  import Effectful.State.Static.Local
  import Skeletest
  import Skeletest.Predicate ((>>>))
  import Skeletest.Predicate qualified as P
  import Telescope.Asdf.Encoding.File
  import Telescope.Asdf.Error
  
  
  spec :: Spec
  spec = do
    describe "blocks" testBlocks
    describe "split-file" testSplit
  
  
  testBlocks :: Spec
  testBlocks = do
    let blockHeadZero = BlockHeader 1 0 NoCompression 0 0 0 noChecksum
  
    describe "BlockHeader" $ do
      it "should parse zero" $ do
        let bh = runPut (putBlockHeader blockHeadZero)
        goGet getBlockHeader bh `shouldBe` Right blockHeadZero
  
      it "should create from data" $ do
        let block = BlockData "hello"
        let bh = blockHeader block
  
        bh.allocatedSize `shouldBe` 5
        bh.usedSize `shouldBe` 5
        bh.allocatedSize `shouldBe` 5
        bh.usedSize `shouldBe` 5
        bh.dataSize `shouldBe` 5
        bh.headerSize `shouldSatisfy` P.gte 48
  
    describe "putBlock" $ do
      it "puts a header" $ do
        runPut (putBlockHeader blockHeadZero) `shouldSatisfy` (BL.length >>> P.gt 10)
  
      it "puts a block" $ do
        runPut (putBlock $ BlockData "hello") `shouldSatisfy` (BL.length >>> P.gt 10)
  
    describe "getBlock" $ do
      it "fails on empty data" $ do
        goGet getBlock "" `shouldSatisfy` P.left P.anything
  
      it "fails if missing magic byte" $ do
        goGet getBlock "asdf" `shouldSatisfy` P.left P.anything
  
      it "puts an empty block" $ do
        let out = runPut (putBlock $ BlockData "")
        goGet getBlock out `shouldBe` Right (BlockData "")
  
    describe "getBlocks" $ do
      it "looks ahead without failing" $ do
        goGet checkMagicToken "asdf" `shouldBe` Right False
  
      it "gets a single block" $ do
        let out = runPut (putBlock $ BlockData "")
        goGet getBlocks out `shouldBe` Right [BlockData ""]
  
      it "gets empty array" $ do
        goGet getBlocks "" `shouldBe` Right []
   where
    goGet a bs =
      case runGetOrFail a bs of
        Left e -> Left e
        Right (_, _, x) -> Right x
  
  
  testSplit :: Spec
  testSplit = do
    describe "parse tree" $ do
      it "empty" $ do
        t <- runParse "" parseTree
        t `shouldBe` Encoded ""
  
      it "tree only" $ do
        (t, rest) <- runParse "value" $ do
          t <- parseTree
          rest <- get @ByteString
          pure (t, rest)
        t `shouldBe` Encoded "value"
        rest `shouldBe` ""
  
      it "tree with data" $ do
        let Encoded bks = encodeBlock (BlockData "woot")
        let inp = "value\n" <> bks
        t <- runParse inp parseTree
        t `shouldBe` Encoded "value\n"
  
      it "tree with index" $ do
        let Encoded ix = encodeIndex (BlockIndex [4])
        let inp = "value\n" <> ix
        (t, rest) <- runParse inp $ do
          t <- parseTree
          rest <- get @ByteString
          pure (t, rest)
        t `shouldBe` Encoded "value\n"
        rest `shouldBe` ix
  
      it "tree with all" $ do
        let Encoded bks = encodeBlock (BlockData "woot")
        let Encoded ix = encodeIndex (BlockIndex [4])
        let inp = "value\n" <> bks <> ix
        t <- runParse inp parseTree
        t `shouldBe` Encoded "value\n"
  
    describe "parse blocks" $ do
      it "one block" $ do
        let Encoded blks = encodeBlock (BlockData "woot")
        n <- runParse blks parseBlock
        n `shouldBe` Encoded blks
  
      it "first block" $ do
        let Encoded b1 = encodeBlock (BlockData "b1")
        let Encoded b2 = encodeBlock (BlockData "b2")
        b <- runParse (b1 <> b2) parseBlock
        b `shouldBe` Encoded b1
  
      it "block with index" $ do
        let Encoded b1 = encodeBlock (BlockData "b1")
        let Encoded ix = encodeIndex (BlockIndex [10])
        let inp = b1 <> ix
        n <- runParse inp parseBlock
        n `shouldBe` Encoded b1
  
      it "blocks" $ do
        let Encoded b1 = encodeBlock (BlockData "b1")
        let Encoded b2 = encodeBlock (BlockData "b2")
        let inp = b1 <> b2
        bs <- runParse inp parseBlocks
        bs `shouldBe` [Encoded b1, Encoded b2]
  
      it "blocks and index" $ do
        let Encoded b1 = encodeBlock (BlockData "b1")
        let Encoded b2 = encodeBlock (BlockData "b2")
        let Encoded ix = encodeIndex (BlockIndex [10])
        let inp = b1 <> b2 <> ix
        bs <- runParse inp parseBlocks
        bs `shouldBe` [Encoded b1, Encoded b2]
  
    describe "basic data" $ do
      it "should parse empty" $ do
        af <- split ""
        af `shouldBe` AsdfFile "" [] ""
  
      it "just a tree" $ do
        af <- split "tree"
        af.tree `shouldBe` "tree"
        af.blocks `shouldBe` []
        af.index `shouldBe` ""
  
    describe "optionals" $ do
      it "tree + data!" $ do
        let treeData = "#hello"
        let tree = Encoded treeData
        let blocks = [encodeBlock (BlockData "data")]
        let ix = encodeIndex (blockIndex tree blocks)
        let inp = concatAsdfFile $ AsdfFile{tree = Encoded treeData, blocks, index = ix}
        af <- split inp
        af.tree `shouldBe` "#hello"
        af.blocks `shouldBe` blocks
        af.index `shouldBe` ix
  
      it "all parts" $ do
        let treeData = "#hello\n"
        let blocks = [encodeBlock (BlockData "data")]
        let index = encodeIndex (BlockIndex [BS.length treeData])
        let out = concatAsdfFile $ AsdfFile{tree = Encoded treeData, blocks, index}
        af <- split out
        af.tree `shouldBe` Encoded "#hello\n"
        af.blocks `shouldBe` blocks
        af.index `shouldBe` index
  
      it "optional blocks" $ do
        af <- split "asdf"
        af `shouldBe` AsdfFile "asdf" [] ""
  
      it "optional tree" $ do
        let Encoded out = encodeBlock $ BlockData "hello"
        af <- split out
        af.tree `shouldBe` Encoded ""
        af.blocks `shouldBe` [Encoded out]
        af.index `shouldBe` ""
  
      it "tree and index" $ do
        let out = "tree\n" <> blockIndexHeader <> "index"
        af <- split out
        af.tree `shouldBe` "tree\n"
        af.blocks `shouldBe` []
        af.index `shouldBe` Encoded (blockIndexHeader <> "index")
  
    describe "real asdf file" $ do
      it "tree smaller than document " $ do
        ExampleFileFix inp dp <- getFixture
        BS.length dp.tree.bytes `shouldNotBe` BS.length inp
  
      it "tree exists" $ do
        ExampleFileFix _ dp <- getFixture
        BS.length dp.tree.bytes `shouldSatisfy` P.gt 0
  
      it "blocks exist" $ do
        ExampleFileFix _ dp <- getFixture
        length dp.blocks `shouldSatisfy` P.gt 0
  
      it "index exists" $ do
        ExampleFileFix _ dp <- getFixture
        BS.length dp.index.bytes `shouldSatisfy` P.gt 0
   where
    split :: BS.ByteString -> IO AsdfFile
    split inp = runAsdfM $ splitAsdfFile inp
  
    runParse :: ByteString -> Eff [NonDet, State ByteString, IOE] a -> IO a
    runParse inp eff = do
      ret <- runEff . runState inp . runNonDet OnEmptyKeep $ eff
      case ret of
        (Left _, rest) -> fail $ "Failed parse at: " ++ show (BS.take 100 rest)
        (Right a, _) -> pure a
  
  
  data ExampleFileFix = ExampleFileFix {input :: BS.ByteString, file :: AsdfFile}
  instance Fixture ExampleFileFix where
    fixtureAction = do
      inp <- BS.readFile "samples/example.asdf"
      f <- runAsdfM $ splitAsdfFile inp
      pure $ noCleanup $ ExampleFileFix inp f
  