{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

import           Control.Monad
import           Data.Aeson
import qualified Data.ByteString.Lazy as BSL
import           Data.KindID (KindID)
import qualified Data.KindID as KID
import qualified Data.Text as T
import           Data.TypeID (TypeID, TypeIDError)
import qualified Data.TypeID as TID
import qualified Data.UUID.V7 as V7
import           GHC.Generics (Generic)
import           Test.Hspec

data TestData = TestData { name        :: String
                         , typeid      :: String
                         , prefix      :: Maybe String
                         , uuid        :: Maybe String }
  deriving (Generic, FromJSON, ToJSON)

anyTypeIDError :: Selector TypeIDError
anyTypeIDError = const True

main :: IO ()
main = do
  invalid <- BSL.readFile "test/invalid.json" >>= throwDecode :: IO [TestData]
  valid   <- BSL.readFile "test/valid.json" >>= throwDecode :: IO [TestData]

  hspec do
    describe "Generate TypeID" do
      it "can generate TypeID with prefix" do
        tid <- TID.genTypeID "mmzk"
        TID.getPrefix tid `shouldBe` "mmzk"
      it "can generate TypeID without prefix" do
        tid <- TID.genTypeID ""
        TID.getPrefix tid `shouldBe` ""
      it "can parse TypeID from String" do
        case TID.parseString "mmzk_00041061050r3gg28a1c60t3gf" of
          Left err  -> expectationFailure $ "Parse error: " ++ show err
          Right tid -> pure ()
      it "has the correct nil" do
        Right TID.nil `shouldBe` TID.parseString "00000000000000000000000000"
      it "can generate in batch with same timestamp and in ascending order" do
        tids <- TID.genTypeIDs "mmzk" 1526
        all ((== "mmzk") . TID.getPrefix) tids `shouldBe` True
        let timestamp = TID.getTime $ head tids
        all ((== timestamp) . TID.getTime) tids `shouldBe` True
        all (uncurry (<)) (zip tids $ tail tids) `shouldBe` True

    describe "Parse TypeID" do
      let invalidPrefixes = [ ("caps", "PREFIX")
                            , ("numeric", "12323")
                            , ("symbols", "pre.fix")
                            , ("spaces", "  ")
                            , ("long", "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz")
                            , ("ascii", "château") ]
      describe "can detect invalid prefix" do
        forM_ invalidPrefixes \(reason, prefix) -> it reason do
          TID.genTypeID prefix `shouldThrow` anyTypeIDError
          case TID.decorate prefix V7.nil of
            Left _  -> pure ()
            Right _ -> expectationFailure "Should not be able to decorate with invalid prefix"
      let invalidSuffixes = [ ("spaces", " ")
                            , ("short", "01234")
                            , ("long", "012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789")
                            , ("caps", "00041061050R3GG28A1C60T3GF") -- Would be valid in lowercase
                            , ("hyphens", "00041061050-3gg28a1-60t3gf")
                            , ("crockford_ambiguous", "ooo41o61o5or3gg28a1c6ot3gi") -- Would be valid if we followed Crockford's substitution rules
                            , ("symbols", "00041061050.3gg28a1_60t3gf")
                            , ("wrong_alphabet", "ooooooiiiiiiuuuuuuulllllll") ]
      describe "can detect invalid suffix" do
        forM_ invalidSuffixes \(reason, suffix) -> it reason do
          case TID.parseStringWithPrefix "mmzk" suffix of
            Left _    -> pure ()
            Right tid -> expectationFailure $ "Parsed TypeID: " ++ TID.toString tid

    describe "Parse special values" do
      let specialValues = [ ("nil", "00000000000000000000000000", "00000000-0000-0000-0000-000000000000")
                          , ("one", "00000000000000000000000001", "00000000-0000-0000-0000-000000000001")
                          , ("ten", "0000000000000000000000000a", "00000000-0000-0000-0000-00000000000a")
                          , ("sixteen", "0000000000000000000000000g", "00000000-0000-0000-0000-000000000010")
                          , ("thirty-two", "00000000000000000000000010", "00000000-0000-0000-0000-000000000020") ]
      forM_ specialValues \(reason, tid, uuid) -> it reason do
        case TID.parseString tid of
          Left err  -> expectationFailure $ "Parse error: " ++ show err
          Right tid -> V7.toString (TID.getUUID tid) `shouldBe` uuid

    describe "Test invalid.json" do
      forM_ invalid \(TestData name tid _ _) -> it name do 
        case TID.parseString tid of
          Left _    -> pure ()
          Right tid -> expectationFailure $ "Parsed TypeID: " ++ TID.toString tid

    describe "Test valid.json" do
      forM_ valid \(TestData name tid (Just prefix) (Just uuid)) -> it name do
        case TID.parseString tid of
          Left err  -> expectationFailure $ "Parse error: " ++ show err
          Right tid -> do
            TID.getPrefix tid `shouldBe` T.pack prefix
            V7.toString (TID.getUUID tid) `shouldBe` uuid

    describe "Generate type-level TypeID" do
      it "can generate TypeID with prefix" do
        tid <- KID.genKindID @"mmzk"
        KID.getPrefix tid `shouldBe` "mmzk"
      it "can generate TypeID without prefix" do
        tid <- KID.genKindID @""
        KID.getPrefix tid `shouldBe` ""
      it "can parse TypeID from String" do
        case KID.parseString @"mmzk" "mmzk_00041061050r3gg28a1c60t3gf" of
          Left err  -> expectationFailure $ "Parse error: " ++ show err
          Right tid -> pure ()
      it "cannot parse TypeID into wrong prefix" do
        case KID.parseString @"foo" "mmzk_00041061050r3gg28a1c60t3gf" of
          Left err  -> pure ()
          Right tid -> expectationFailure $ "Parsed TypeID: " ++ KID.toString tid
      it "has the correct nil" do
        Right KID.nil `shouldBe` KID.parseString @"" "00000000000000000000000000"
      it "can generate in batch with same timestamp and in ascending order" do
        kids <- KID.genKindIDs @"mmzk" 1526
        all ((== "mmzk") . KID.getPrefix) kids `shouldBe` True
        let timestamp = KID.getTime $ head kids
        all ((== timestamp) . KID.getTime) kids `shouldBe` True
        all (uncurry (<)) (zip kids $ tail kids) `shouldBe` True