{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Test.Database.Migrations where

import Hedgehog
import qualified Hedgehog.Corpus as Corpus
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Tasty
import Test.Tasty.Hedgehog

import qualified Data.Text as T

import Data.Aeson
import Data.Proxy
       (Proxy(..))
import GHC.Generics
       (Generic)

import Database.Migrations

newtype Foo_0 = Foo_0 { name :: String }
  deriving stock (Show, Eq, Generic)
  deriving anyclass (ToJSON, FromJSON)

data Foo_1 = Foo_1 { name :: String, age :: Int }
  deriving stock (Show, Eq, Generic)
  deriving anyclass (ToJSON, FromJSON)

data Foo = Foo { name :: T.Text, age :: Int }
  deriving stock (Show, Eq, Generic)
  deriving anyclass (ToJSON, FromJSON)

instance SafeJSON Foo_0 where
  type Version Foo_0 = 0
  kind = Base

instance SafeJSON Foo_1 where
  type Version Foo_1 = 1
  kind = Extends Proxy

instance SafeJSON Foo where
  type Version Foo = 1
  kind = Extends Proxy

instance Migrate Foo_1 where
  type MigrateFrom Foo_1 = Foo_0
  migrate Foo_0{..} = Just Foo_1{name=name, age=0}

instance Migrate Foo where
  type MigrateFrom Foo = Foo_1
  migrate Foo_1{..} = Just Foo{name=T.pack name, age=age}

genFoo :: Gen Foo
genFoo = Foo <$> Gen.element Corpus.simpsons <*> Gen.integral (Range.linear 0 100)

genFoo_1 :: Gen Foo_1
genFoo_1 = Foo_1 <$> Gen.element Corpus.simpsons <*> Gen.integral (Range.linear 0 100)

genFoo_0 :: Gen Foo_0
genFoo_0 = Foo_0 <$> Gen.element Corpus.simpsons

prop_roundtrip_same_version :: Property
prop_roundtrip_same_version = property $ do
  x <- forAll genFoo
  tripping x toVersioned fromVersioned

prop_roundtrip_one_migration :: Property
prop_roundtrip_one_migration = property $ do
  x <- forAll genFoo_1
  fromVersioned (toVersioned x) === maybe (Error "No migrations") Success (migrate @Foo x)

prop_roundtrip_multiple_migration :: Property
prop_roundtrip_multiple_migration = property $ do
  x <- forAll genFoo_0
  fromVersioned (toVersioned x) === maybe (Error "No migrations") Success (migrate x >>= migrate @Foo)

tests :: TestTree
tests = testGroup "Database.Migrations"
  [ testProperty "Roundtrip with same version" prop_roundtrip_same_version
  , testProperty "Roundtrip with one migration" prop_roundtrip_one_migration
  , testProperty "Roundtrip with multiple migrations" prop_roundtrip_multiple_migration
  ]