-- Copyright (c) 2020, Shayne Fletcher. All rights reserved.
-- SPDX-License-Identifier: BSD-3-Clause.

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
#include "ghclib_api.h"

module Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances (
    HsExtendInstances(..), extendInstances, astEq, astListEq)
where

-- At times, there are terms in Haskell syntax we work with that are
-- not in `Eq`, `Show` or `Ord` and we need them to be.

-- This work-around resorts to implementing Eq and Ord via
-- lexicographic string comparisons. As long as two different terms
-- never map to the same string, basing `Eq` and `Ord` on their string
-- representations rather than the terms themselves, leads to
-- identical results.

#if defined (GHCLIB_API_HEAD) || defined(GHCLIB_API_902) || defined (GHCLIB_API_900)
import GHC.Utils.Outputable
#else
import Outputable
#endif
import Data.Data
import Data.Function
import Language.Haskell.GhclibParserEx.Dump

newtype HsExtendInstances a =
  HsExtendInstances { HsExtendInstances a -> a
unextendInstances :: a }
    deriving Rational -> HsExtendInstances a -> SDoc
HsExtendInstances a -> SDoc
(HsExtendInstances a -> SDoc)
-> (Rational -> HsExtendInstances a -> SDoc)
-> Outputable (HsExtendInstances a)
forall a. Outputable a => Rational -> HsExtendInstances a -> SDoc
forall a. Outputable a => HsExtendInstances a -> SDoc
forall a. (a -> SDoc) -> (Rational -> a -> SDoc) -> Outputable a
pprPrec :: Rational -> HsExtendInstances a -> SDoc
$cpprPrec :: forall a. Outputable a => Rational -> HsExtendInstances a -> SDoc
ppr :: HsExtendInstances a -> SDoc
$cppr :: forall a. Outputable a => HsExtendInstances a -> SDoc
Outputable

extendInstances :: a -> HsExtendInstances a
extendInstances :: a -> HsExtendInstances a
extendInstances = a -> HsExtendInstances a
forall a. a -> HsExtendInstances a
HsExtendInstances

-- Use 'showAstData'. This is preferable to 'ppr' in that trees that
-- only differ in arrangement due to fixities will produce differing
-- string representations.
toStr :: Data a => HsExtendInstances a -> String
toStr :: HsExtendInstances a -> String
toStr (HsExtendInstances a
e) =
#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
  showPprUnsafe $ showAstData BlankSrcSpan BlankEpAnnotations e
#else
  SDoc -> String
showSDocUnsafe (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ BlankSrcSpan -> a -> SDoc
forall a. Data a => BlankSrcSpan -> a -> SDoc
showAstData BlankSrcSpan
BlankSrcSpan a
e
#endif

instance Data a => Eq (HsExtendInstances a) where == :: HsExtendInstances a -> HsExtendInstances a -> Bool
(==) HsExtendInstances a
a HsExtendInstances a
b = HsExtendInstances a -> String
forall a. Data a => HsExtendInstances a -> String
toStr HsExtendInstances a
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== HsExtendInstances a -> String
forall a. Data a => HsExtendInstances a -> String
toStr HsExtendInstances a
b
instance Data a => Ord (HsExtendInstances a) where compare :: HsExtendInstances a -> HsExtendInstances a -> Ordering
compare = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (HsExtendInstances a -> String)
-> HsExtendInstances a
-> HsExtendInstances a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` HsExtendInstances a -> String
forall a. Data a => HsExtendInstances a -> String
toStr

astEq :: Data a => a -> a -> Bool
astEq :: a -> a -> Bool
astEq a
a a
b = a -> HsExtendInstances a
forall a. a -> HsExtendInstances a
extendInstances a
a HsExtendInstances a -> HsExtendInstances a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> HsExtendInstances a
forall a. a -> HsExtendInstances a
extendInstances a
b

astListEq :: Data a => [a] -> [a] -> Bool
astListEq :: [a] -> [a] -> Bool
astListEq [a]
as [a]
bs = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
bs Bool -> Bool -> Bool
&& ((a, a) -> Bool) -> [(a, a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((a -> a -> Bool) -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Bool
forall a. Data a => a -> a -> Bool
astEq) ([a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [a]
bs)

-- Use 'ppr' for 'Show'.
instance Outputable a => Show (HsExtendInstances a) where
  show :: HsExtendInstances a -> String
show (HsExtendInstances a
e) =
#if defined(GHCLIB_API_HEAD) || defined(GHCLIB_API_902)
    showPprUnsafe $ ppr e
#else
    SDoc -> String
showSDocUnsafe (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
e
#endif