{-# LANGUAGE DeriveGeneric, DataKinds, FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module V1 where

import Data.Serialize ( getWord64le
                      , put
                      , putListOf
                      , putWord64le
                      )
import Data.Serialize.Versioned ( VersionDomain(CurrentVersion)
                                , VersionedSerialize(CurrentStructureVersion)
                                , VersionedGettable( MigrationVariant
                                                   , migrate
                                                   , versionedGet
                                                   )
                                , MigrationType( Base
                                               , Unchanged
                                               , SerializationChanged
                                               , RepresentationChanged
                                               )
                                , getUnversioned
                                , putVersioned
                                , putUnversioned
                                , putUnversionedResumable
                                )
import Data.Word (Word64)
import GHC.Generics (Generic)

import Common

instance VersionDomain TestDomain where
  type CurrentVersion TestDomain = 1

instance ( VersionedSerialize TestDomain a
         , CurrentStructureVersion TestDomain a ~ 1
         ) => VersionedSerialize TestDomain [a] where
  putVersioned xs = putUnversionedResumable $ \resume ->
    putListOf (resume . putVersioned) xs

instance VersionedSerialize TestDomain Word64 where
  -- This type isn't actually used in version 1
  type CurrentStructureVersion TestDomain Word64 = 0
  putVersioned = putUnversioned . put

instance VersionedSerialize TestDomain Char where
  putVersioned = putUnversioned . put

instance VersionedSerialize TestDomain Integer where
  putVersioned = putUnversioned . put

data Foo = Foo Bar Baz
  deriving (Generic, Eq, Show)

instance VersionedGettable TestDomain 0 Foo where
  type MigrationVariant TestDomain 0 Foo = 'Base
instance VersionedGettable TestDomain 1 Foo where
  type MigrationVariant TestDomain 1 Foo = 'Unchanged

instance VersionedSerialize TestDomain Foo

newtype Bar = Bar Word64
  deriving (Generic, Eq, Show)

instance VersionedGettable TestDomain 0 Bar where
  type MigrationVariant TestDomain 0 Bar = 'Base
instance VersionedGettable TestDomain 1 Bar where
  type MigrationVariant TestDomain 1 Bar = 'SerializationChanged
  versionedGet = Bar <$> getUnversioned getWord64le

instance VersionedSerialize TestDomain Bar where
  putVersioned (Bar x) = putUnversioned $ putWord64le x

data Baz = Baz String BazSub
  deriving (Generic, Eq, Show)

instance VersionedGettable TestDomain 0 Baz where
  type MigrationVariant TestDomain 0 Baz = 'Base
instance VersionedGettable TestDomain 1 Baz where
  type MigrationVariant TestDomain 1 Baz = 'Unchanged

instance VersionedSerialize TestDomain Baz

data BazSubV0 = BazSubV0 Integer | BazSubNoneV0
  deriving (Generic, Eq, Show)
data BazSub = BazSub NewSub | BazSubNone
  deriving (Generic, Eq, Show)

instance VersionedGettable TestDomain 0 BazSubV0 where
  type MigrationVariant TestDomain 0 BazSubV0 = 'Base

instance VersionedGettable TestDomain 1 BazSub where
  type MigrationVariant TestDomain 1 BazSub = 'RepresentationChanged BazSubV0
  migrate (BazSubV0 _) = BazSub NewSub
  migrate BazSubNoneV0 = BazSubNone

instance VersionedSerialize TestDomain BazSub

data NewSub = NewSub
  deriving (Generic, Eq, Show)

instance VersionedGettable TestDomain 1 NewSub where
  type MigrationVariant TestDomain 1 NewSub = 'Base

instance VersionedSerialize TestDomain NewSub