Skip to content

Commit a24c404

Browse files
author
Poscat
committed
Fix compatibility with older ghc versions
1 parent dcbcf15 commit a24c404

File tree

2 files changed

+9
-10
lines changed

2 files changed

+9
-10
lines changed

Data/Aeson/Types/FromJSON.hs

Lines changed: 8 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE PartialTypeSignatures #-}
12
{-# LANGUAGE CPP #-}
23
{-# LANGUAGE DataKinds #-}
34
{-# LANGUAGE DefaultSignatures #-}
@@ -10,7 +11,6 @@
1011
{-# LANGUAGE PolyKinds #-}
1112
{-# LANGUAGE RecordWildCards #-}
1213
{-# LANGUAGE ScopedTypeVariables #-}
13-
{-# LANGUAGE TypeApplications #-}
1414
{-# LANGUAGE TypeOperators #-}
1515
{-# LANGUAGE TupleSections #-}
1616
{-# LANGUAGE UndecidableInstances #-}
@@ -159,8 +159,7 @@ import qualified Data.Primitive.Types as PM
159159
import qualified Data.Primitive.PrimArray as PM
160160

161161
import Data.Coerce (Coercible, coerce)
162-
import GHC.TypeNats
163-
import Data.Kind (Type)
162+
import GHC.TypeLits
164163

165164
parseIndexedJSON :: (Value -> Parser a) -> Int -> Value -> Parser a
166165
parseIndexedJSON p idx value = p value <?> Index idx
@@ -1435,11 +1434,11 @@ instance ( IsRecord f isRecord
14351434
, Constructor c
14361435
) => FromTaggedFlatObject arity (C1 c f) where
14371436
parseTaggedFlatObject (tag :* p@(_ :* opts :* _)) obj
1438-
| tag == tag' = Just $ fmap M1 $ (unTagged @Type @isRecord) $ parseTaggedFlatObject' (cname :* p) obj
1437+
| tag == tag' = Just $ fmap M1 $ (unTagged :: Tagged isRecord _ -> _) $ parseTaggedFlatObject' (cname :* p) obj
14391438
| otherwise = Nothing
14401439
where
14411440
tag' = pack $ constructorTagModifier opts cname
1442-
cname = conName (undefined :: M1 i c a p)
1441+
cname = conName (undefined :: M1 i c f p)
14431442

14441443
class FromTaggedFlatObject' arity f isRecord where
14451444
parseTaggedFlatObject' :: ConName :* TypeName :* Options :* FromArgs arity a
@@ -1453,7 +1452,7 @@ instance FromTaggedFlatObject' arity U1 False where
14531452
parseTaggedFlatObject' _ _ = Tagged (pure U1)
14541453

14551454
instance OVERLAPPABLE_ (PositionFromObject 1 arity f) => FromTaggedFlatObject' arity f False where
1456-
parseTaggedFlatObject' (_ :* p) obj = Tagged (positionFromObject (Proxy @1) p obj)
1455+
parseTaggedFlatObject' (_ :* p) obj = Tagged (positionFromObject (Proxy :: Proxy 1) p obj)
14571456

14581457
class KnownNat n => PositionFromObject n arity f where
14591458
positionFromObject :: Proxy n
@@ -1463,15 +1462,15 @@ class KnownNat n => PositionFromObject n arity f where
14631462

14641463
instance (KnownNat n, GFromJSON arity a) => PositionFromObject n arity (S1 m a) where
14651464
positionFromObject _ (_ :* opts :* fargs) obj =
1466-
explicitParseField (gParseJSON opts fargs) obj $ pack $ show $ natVal $ Proxy @n
1465+
explicitParseField (gParseJSON opts fargs) obj $ pack $ show $ natVal (Proxy :: Proxy n)
14671466

14681467
instance ( PositionFromObject n arity f
14691468
, PositionFromObject (n+1) arity g
14701469
) => PositionFromObject n arity (f :*: g) where
14711470
positionFromObject _ p obj =
14721471
(:*:)
1473-
<$> positionFromObject (Proxy @n) p obj
1474-
<*> positionFromObject (Proxy @(n+1)) p obj
1472+
<$> positionFromObject (Proxy :: Proxy n) p obj
1473+
<*> positionFromObject (Proxy :: Proxy (n+1)) p obj
14751474

14761475
--------------------------------------------------------------------------------
14771476

Data/Aeson/Types/ToJSON.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -142,7 +142,7 @@ import qualified Data.Primitive.Array as PM
142142
import qualified Data.Primitive.SmallArray as PM
143143
import qualified Data.Primitive.Types as PM
144144
import qualified Data.Primitive.PrimArray as PM
145-
import GHC.TypeNats
145+
import GHC.TypeLits
146146

147147
toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value
148148
toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)

0 commit comments

Comments
 (0)