Common.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module API.Common where

import Data.Aeson hiding (Key)
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Maybe
import Data.TreeDiff.Class
import Data.TreeDiff.Pretty
import qualified Data.Vector as Vec
import GHC.Generics
import GitLab
  ( ArchiveFormat (..),
    Artifact (Artifact),
    BoardIssue (BoardIssue),
    BoardIssueLabel (BoardIssueLabel),
    Branch (Branch),
    Change (Change),
    CommandsChanges (CommanandsChanges),
    Commit (Commit),
    CommitNote (CommitNote),
    CommitStats (CommitStats),
    CommitTodo (CommitTodo),
    Contributor (Contributor),
    DetailedStatus (DetailedStatus),
    Diff (Diff),
    DiffRefs (DiffRefs),
    Discussion (Discussion),
    EditIssueReq (EditIssueReq),
    Email (..),
    Epic (Epic),
    Event (..),
    EventActionName (..),
    EventTargetType (..),
    ExpirationPolicy (ExpirationPolicy),
    Group (Group),
    GroupShare (GroupShare),
    Identity (Identity),
    Issue (Issue),
    IssueBoard (IssueBoard),
    IssueCounts (IssueCounts),
    IssueStatistics (IssueStatistics),
    IssueStats (IssueStats),
    Job (Job),
    Key (..),
    License (License),
    Links (Links),
    Member (Member),
    MergeRequest (MergeRequest),
    Milestone (Milestone),
    MilestoneState (..),
    Namespace (Namespace),
    Note (Note),
    Owner (Ownwer),
    Permissions (Permissions),
    Pipeline (Pipeline),
    Project (Project),
    ProjectAvatar (ProjectAvatar),
    PushData (..),
    References (References),
    Release (Release),
    Repository (Repository),
    RepositoryFile (RepositoryFile),
    RepositoryFileBlame (RepositoryFileBlame),
    RepositoryFileSimple (RepositoryFileSimple),
    RepositoryStorage (RepositoryStorage),
    SamlIdentity (SamlIdentity),
    Starrer (Starrer),
    Statistics (Statistics),
    Tag (Tag),
    TaskCompletionStatus (TaskCompletionStatus),
    TestCase (TestCase),
    TestReport (TestReport),
    TestSuite (TestSuite),
    TimeEstimate (TimeEstimate),
    TimeStats (TimeStats),
    Todo (Todo),
    TodoAction (..),
    TodoProject (TodoProject),
    TodoState (..),
    TodoTarget (..),
    TodoTargetType (..),
    User (User),
    UserCount (..),
    UserPrefs (..),
    UserStatus (..),
    Version (Version),
    Visibility (..),
  )
import Test.Tasty
import Test.Tasty.HUnit
import qualified Text.PrettyPrint.ANSI.Leijen as WL

removeNulls :: Value -> Maybe Value
removeNulls Null = Nothing
removeNulls (Array vec) = Just (Array (Vec.mapMaybe removeNulls vec))
removeNulls (String x) = Just $ String x
removeNulls (Number x) = Just $ Number x
removeNulls (Bool x) = Just $ Bool x
removeNulls (Object keyMap) = Just $ Object (KeyMap.mapMaybe removeNulls keyMap)

gitlabJsonParserTests :: (ToExpr a, FromJSON a, ToJSON a, Eq a, Show a) => String -> FilePath -> IO a -> IO a -> [TestTree]
gitlabJsonParserTests testPrefix jsonFilename parseFileF decodedCustomTypeF = do
  [ testCase
      (testPrefix <> "-decode-encode-decode")
      (decodeEncodeDecode parseFileF),
    testCase
      (testPrefix <> "-json-values-equal")
      (jsonValuesEqual jsonFilename decodedCustomTypeF)
    ]

decodeEncodeDecode :: (ToExpr a, FromJSON a, ToJSON a, Eq a, Show a) => IO a -> Assertion
decodeEncodeDecode parseFileF = do
  decodedFromFile <- parseFileF
  decodedAgain <- parseOne (encode decodedFromFile)
  (decodedFromFile == decodedAgain)
    @? showWL (ansiWlEditExprCompact (ediff decodedFromFile decodedAgain))

jsonValuesEqual :: (ToExpr a, FromJSON a, ToJSON a, Eq a, Show a) => FilePath -> IO a -> Assertion
jsonValuesEqual jsonFilename decodedCustomTypeF = do
  jsonValueFromFile <- parseValuesFromFile jsonFilename
  decodedCustomType <- decodedCustomTypeF
  let (Just jsonFromCustomType) = decode (encode decodedCustomType) :: Maybe Value
  (jsonValueFromFile == jsonFromCustomType)
    @? showWL (ansiWlEditExprCompact (ediff jsonValueFromFile jsonFromCustomType))

parseValuesFromFile :: String -> IO Value
parseValuesFromFile fname =
  fromJust . removeNulls . fromJust . decode <$> BSL.readFile fname

gitlabParseTestOne :: (ToExpr a, FromJSON a, Eq a, Show a) => a -> String -> Assertion
gitlabParseTestOne expectedHaskellValue filename = do
  raw <- BSL.readFile filename
  result <- parseOne raw
  (expectedHaskellValue == result)
    @? showWL (ansiWlEditExprCompact (ediff expectedHaskellValue result))

showWL :: WL.Doc -> String
showWL doc = WL.displayS (WL.renderSmart 0.4 80 doc) ""

gitlabParseTestMany :: (ToExpr a, FromJSON a, Eq a, Show a) => [a] -> String -> Assertion
gitlabParseTestMany expectedHaskellValue filename = do
  raw <- BSL.readFile filename
  result <- parseMany raw
  (expectedHaskellValue == result)
    @? showWL (ansiWlEditExprCompact (ediff expectedHaskellValue result))

parseOne :: FromJSON a => BSL.ByteString -> IO a
parseOne bs =
  case eitherDecode bs of
    Left err -> assertFailure err
    Right xs -> return xs

parseMany :: FromJSON a => BSL.ByteString -> IO [a]
parseMany bs =
  case eitherDecode bs of
    Left err -> assertFailure err
    Right xs -> return xs

-------------
-- Generic instances

deriving instance Generic ArchiveFormat

deriving instance Generic Member

deriving instance Generic SamlIdentity

deriving instance Generic Identity

deriving instance Generic Namespace

deriving instance Generic Links

deriving instance Generic Owner

deriving instance Generic Permissions

deriving instance Generic Project

deriving instance Generic License

deriving instance Generic ExpirationPolicy

deriving instance Generic RepositoryStorage

deriving instance Generic Statistics

deriving instance Generic User

deriving instance Generic MilestoneState

deriving instance Generic Milestone

deriving instance Generic TimeStats

deriving instance Generic Issue

deriving instance Generic Pipeline

deriving instance Generic DetailedStatus

deriving instance Generic Commit

deriving instance Generic CommitTodo

deriving instance Generic CommitStats

deriving instance Generic Tag

deriving instance Generic Release

deriving instance Generic Repository

deriving instance Generic Job

deriving instance Generic Artifact

deriving instance Generic Group

deriving instance Generic GroupShare

deriving instance Generic MergeRequest

deriving instance Generic TaskCompletionStatus

deriving instance Generic References

deriving instance Generic Change

deriving instance Generic DiffRefs

deriving instance Generic TodoAction

deriving instance Generic TodoTarget

deriving instance Generic TodoState

deriving instance Generic TodoProject

deriving instance Generic Todo

deriving instance Generic TodoTargetType

deriving instance Generic EditIssueReq

deriving instance Generic Discussion

deriving instance Generic CommitNote

deriving instance Generic Note

deriving instance Generic IssueBoard

deriving instance Generic BoardIssue

deriving instance Generic BoardIssueLabel

deriving instance Generic Visibility

deriving instance Generic TestSuite

deriving instance Generic TestCase

deriving instance Generic TimeEstimate

deriving instance Generic ProjectAvatar

deriving instance Generic Starrer

deriving instance Generic Branch

deriving instance Generic Diff

deriving instance Generic Epic

deriving instance Generic CommandsChanges

deriving instance Generic Contributor

deriving instance Generic RepositoryFile

deriving instance Generic RepositoryFileSimple

deriving instance Generic RepositoryFileBlame

deriving instance Generic Version

deriving instance Generic IssueStatistics

deriving instance Generic IssueStats

deriving instance Generic IssueCounts

deriving instance Generic TestReport

deriving instance Generic Email

deriving instance Generic Key

deriving instance Generic UserPrefs

deriving instance Generic UserStatus

deriving instance Generic UserCount

deriving instance Generic Event

deriving instance Generic EventActionName

deriving instance Generic EventTargetType

deriving instance Generic PushData

-------------
-- ToExpr instances

instance ToExpr ArchiveFormat

instance ToExpr Member

instance ToExpr SamlIdentity

instance ToExpr Identity

instance ToExpr Namespace

instance ToExpr Links

instance ToExpr Owner

instance ToExpr Permissions

instance ToExpr Project

instance ToExpr Statistics

instance ToExpr User

instance ToExpr Milestone

instance ToExpr MilestoneState

instance ToExpr TimeStats

instance ToExpr Issue

instance ToExpr Pipeline

instance ToExpr Commit

instance ToExpr CommitTodo

instance ToExpr CommitStats

instance ToExpr Tag

instance ToExpr Release

instance ToExpr Diff

instance ToExpr Repository

instance ToExpr Job

instance ToExpr Artifact

instance ToExpr Group

instance ToExpr GroupShare

instance ToExpr Branch

instance ToExpr RepositoryFile

instance ToExpr RepositoryFileSimple

instance ToExpr RepositoryFileBlame

instance ToExpr MergeRequest

instance ToExpr Todo

instance ToExpr TodoProject

instance ToExpr TodoAction

instance ToExpr TodoTarget

instance ToExpr TodoState

instance ToExpr Version

instance ToExpr EditIssueReq

instance ToExpr Discussion

instance ToExpr CommitNote

instance ToExpr Note

instance ToExpr IssueStatistics

instance ToExpr IssueStats

instance ToExpr IssueCounts

instance ToExpr IssueBoard

instance ToExpr BoardIssue

instance ToExpr BoardIssueLabel

instance ToExpr Visibility

instance ToExpr TestReport

instance ToExpr TestSuite

instance ToExpr TestCase

instance ToExpr TimeEstimate

instance ToExpr TaskCompletionStatus

instance ToExpr References

instance ToExpr Change

instance ToExpr DiffRefs

instance ToExpr DetailedStatus

instance ToExpr TodoTargetType

instance ToExpr License

instance ToExpr ExpirationPolicy

instance ToExpr RepositoryStorage

instance ToExpr Starrer

instance ToExpr ProjectAvatar

instance ToExpr Epic

instance ToExpr CommandsChanges

instance ToExpr Contributor

instance ToExpr Email

instance ToExpr Key

instance ToExpr UserPrefs

instance ToExpr UserStatus

instance ToExpr UserCount

instance ToExpr Event

instance ToExpr EventActionName

instance ToExpr EventTargetType

instance ToExpr PushData