Migratory

{-# LANGUAGE
    DeriveAnyClass
  , DeriveGeneric
  , DerivingStrategies
  , GADTs
  , LambdaCase
  , OverloadedStrings
#-}

module Migratory where

import Data.Aeson
import Data.Aeson.Parser.Internal
import Data.Aeson.Types
import Data.ByteString.Lazy
import GHC.Generics

data Version x where
  Version0 :: Version x
  Patch :: FromJSON x => (x -> y) -> Version x -> Version y

data Versioned x = Versioned
  { version :: Integer
  , payload :: x
  } deriving stock (Show, Generic)
    deriving anyclass (FromJSON, ToJSON)

versionN :: Version x -> Integer
versionN = \case
  Version0 -> 0
  _ `Patch` version -> 1 + versionN version

parseVersionedJSON :: FromJSON x => Version x -> Value -> Parser x
parseVersionedJSON version json = do
  Versioned v x <- parseJSON json
  if v == versionN version
  then parseJSON x
  else case version of
    Version0 -> fail "versioned json parsing failed"
    patch `Patch` oldVersion -> patch <$> parseVersionedJSON oldVersion json

decodeVersionedJSON :: FromJSON x => Version x -> ByteString -> Maybe x
decodeVersionedJSON = decodeWith jsonEOF . parse . parseVersionedJSON

data X0 = X0 String
  deriving stock (Generic, Show)
  deriving anyclass (FromJSON, ToJSON)

data X1 = X1 String (Maybe Double)
  deriving stock (Generic, Show)
  deriving anyclass (FromJSON, ToJSON)

data X2 = X2 String (Maybe Double) (Maybe Char)
  deriving stock (Generic, Show)
  deriving anyclass (FromJSON, ToJSON)
 
patch1 :: X0 -> X1
patch1 (X0 str) = X1 str Nothing

patch2 :: X1 -> X2
patch2 (X1 str dbl) = X2 str dbl Nothing

version1 :: Version X1
version1 = patch1 `Patch` Version0

version2 :: Version X2
version2 = patch2 `Patch` version1

encoded0 :: ByteString
encoded0 = encode (Versioned 0 (X0 "foo"))

-- Just (X0 "foo")
test0 :: Maybe X0
test0 = decodeVersionedJSON Version0 encoded0

-- Just (X1 "foo" Nothing)
test1 :: Maybe X1
test1 = decodeVersionedJSON version1 encoded0

-- Just (X2 "foo" Nothing Nothing)
test2 :: Maybe X2
test2 = decodeVersionedJSON version2 encoded0