Types.hs

{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}

module Data.API.Changes.Types
    ( -- * Changelog representation
      APIWithChangelog
    , APIChangelog(..)
    , APIChange(..)
    , MigrationTag
    , VersionExtra(..)
    , showVersionExtra

    , UpdateTypePos(..)
    , UpdateDeclPos(..)
    , APITableChange(..)
    ) where

import           Data.API.PP
import           Data.API.NormalForm
import           Data.API.Types

import           Data.Map ( Map )
import           Data.Version


------------------
-- The key types
--

type APIWithChangelog = (API, APIChangelog)

-- | An API changelog, consisting of a list of versions with the
-- changes from one version to the next.  The versions must be in
-- descending order (according to the 'Ord' 'Version' instance).
data APIChangelog =
     -- | The changes from the previous version up to this version.
     ChangesUpTo VersionExtra [APIChange] APIChangelog
     -- | The initial version
   | ChangesStart Version
    deriving (Eq, Show)

-- | A single change within a changelog
data APIChange
    = ChAddType       TypeName NormTypeDecl
    | ChDeleteType    TypeName
    | ChRenameType    TypeName TypeName

      -- Specific changes for record types
    | ChAddField      TypeName FieldName APIType (Maybe DefaultValue)
    | ChDeleteField   TypeName FieldName
    | ChRenameField   TypeName FieldName FieldName
    | ChChangeField   TypeName FieldName APIType MigrationTag

      -- Changes for union types
    | ChAddUnionAlt    TypeName FieldName APIType
    | ChDeleteUnionAlt TypeName FieldName
    | ChRenameUnionAlt TypeName FieldName FieldName

      -- Changes for enum types
    | ChAddEnumVal    TypeName FieldName
    | ChDeleteEnumVal TypeName FieldName
    | ChRenameEnumVal TypeName FieldName FieldName

      -- Custom migrations
    | ChCustomType    TypeName MigrationTag
    | ChCustomAll     MigrationTag
    deriving (Eq, Show)

instance PPLines APIChange where
  ppLines (ChAddType t d)           = ("added " ++ pp t ++ " ") `inFrontOf` ppLines d
  ppLines (ChDeleteType t)          = ["removed " ++ pp t]
  ppLines (ChRenameType t t')       = ["renamed " ++ pp t ++ " to " ++ pp t']
  ppLines (ChAddField t f ty mb_v)  = [ "changed record " ++ pp t
                                      , "  field added " ++ pp f ++ " :: " ++ pp ty
                                        ++ maybe "" (\ v -> " default " ++ pp v) mb_v]
  ppLines (ChDeleteField t f)       = ["changed record " ++ pp t, "  field removed " ++ pp f]
  ppLines (ChRenameField t f f')    = [ "changed record " ++ pp t
                                      , "  field renamed " ++ pp f ++ " to " ++ pp f']
  ppLines (ChChangeField t f ty c)  = [ "changed record " ++ pp t
                                      , "  field changed " ++ pp f ++ " :: " ++ pp ty
                                        ++ " migration " ++ pp c]
  ppLines (ChAddUnionAlt t f ty)    = [ "changed union " ++ pp t
                                      , "  alternative added " ++ pp f ++ " :: " ++ pp ty]
  ppLines (ChDeleteUnionAlt t f)    = [ "changed union " ++ pp t
                                      , "  alternative removed " ++ pp f]
  ppLines (ChRenameUnionAlt t f f') = [ "changed union " ++ pp t
                                      , "  alternative renamed " ++ pp f ++ " to " ++ pp f']
  ppLines (ChAddEnumVal t f)        = [ "changed enum " ++ pp t
                                      , "  alternative added " ++ pp f]
  ppLines (ChDeleteEnumVal t f)     = [ "changed enum " ++ pp t
                                      , "  alternative removed " ++ pp f]
  ppLines (ChRenameEnumVal t f f')  = [ "changed enum " ++ pp t
                                      , "  alternative renamed " ++ pp f ++ " to " ++ pp f']
  ppLines (ChCustomType t c)        = ["migration record " ++ pp t ++ " " ++ pp c]
  ppLines (ChCustomAll c)           = ["migration " ++ pp c]

-- | Within the changelog, custom migrations are represented as
-- strings, so we have less type-safety.
type MigrationTag = String

-- | Represents either a released version (with a version number) or
-- the version under development, which is newer than any release
data VersionExtra = Release Version
                  | DevVersion
  deriving (Eq, Ord, Show)

showVersionExtra :: VersionExtra -> String
showVersionExtra (Release v) = showVersion v
showVersionExtra DevVersion  = "development"

instance PP VersionExtra where
  pp = showVersionExtra


------------------------
-- Representing updates
--

-- | Represents the positions in a declaration to apply an update
data UpdateDeclPos
    = UpdateHere   (Maybe UpdateDeclPos)
    | UpdateRecord (Map FieldName (Maybe UpdateTypePos))
    | UpdateUnion  (Map FieldName (Maybe UpdateTypePos))
    | UpdateType   UpdateTypePos
    deriving (Eq, Show)

-- | Represents the positions in a type to apply an update
data UpdateTypePos
    = UpdateList UpdateTypePos
    | UpdateMaybe UpdateTypePos
    | UpdateNamed TypeName
    deriving (Eq, Show)

data APITableChange
      -- | An initial API, an APIChange and the positions in which to apply it
    = APIChange NormAPI APIChange (Map TypeName UpdateDeclPos)
      -- | Request to validate the dataset against the given API
    | ValidateData NormAPI
    deriving (Eq, Show)

instance PPLines APITableChange where
  ppLines (APIChange _ c _)  = ppLines c
  ppLines (ValidateData _) = []