1
+ {-# LANGUAGE PartialTypeSignatures #-}
1
2
{-# LANGUAGE CPP #-}
2
3
{-# LANGUAGE DataKinds #-}
3
4
{-# LANGUAGE DefaultSignatures #-}
10
11
{-# LANGUAGE PolyKinds #-}
11
12
{-# LANGUAGE RecordWildCards #-}
12
13
{-# LANGUAGE ScopedTypeVariables #-}
13
- {-# LANGUAGE TypeApplications #-}
14
14
{-# LANGUAGE TypeOperators #-}
15
15
{-# LANGUAGE TupleSections #-}
16
16
{-# LANGUAGE UndecidableInstances #-}
@@ -159,8 +159,7 @@ import qualified Data.Primitive.Types as PM
159
159
import qualified Data.Primitive.PrimArray as PM
160
160
161
161
import Data.Coerce (Coercible , coerce )
162
- import GHC.TypeNats
163
- import Data.Kind (Type )
162
+ import GHC.TypeLits
164
163
165
164
parseIndexedJSON :: (Value -> Parser a ) -> Int -> Value -> Parser a
166
165
parseIndexedJSON p idx value = p value <?> Index idx
@@ -1435,11 +1434,11 @@ instance ( IsRecord f isRecord
1435
1434
, Constructor c
1436
1435
) => FromTaggedFlatObject arity (C1 c f ) where
1437
1436
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
1439
1438
| otherwise = Nothing
1440
1439
where
1441
1440
tag' = pack $ constructorTagModifier opts cname
1442
- cname = conName (undefined :: M1 i c a p )
1441
+ cname = conName (undefined :: M1 i c f p )
1443
1442
1444
1443
class FromTaggedFlatObject' arity f isRecord where
1445
1444
parseTaggedFlatObject' :: ConName :* TypeName :* Options :* FromArgs arity a
@@ -1453,7 +1452,7 @@ instance FromTaggedFlatObject' arity U1 False where
1453
1452
parseTaggedFlatObject' _ _ = Tagged (pure U1 )
1454
1453
1455
1454
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)
1457
1456
1458
1457
class KnownNat n => PositionFromObject n arity f where
1459
1458
positionFromObject :: Proxy n
@@ -1463,15 +1462,15 @@ class KnownNat n => PositionFromObject n arity f where
1463
1462
1464
1463
instance (KnownNat n , GFromJSON arity a ) => PositionFromObject n arity (S1 m a ) where
1465
1464
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 )
1467
1466
1468
1467
instance ( PositionFromObject n arity f
1469
1468
, PositionFromObject (n + 1 ) arity g
1470
1469
) => PositionFromObject n arity (f :*: g ) where
1471
1470
positionFromObject _ p obj =
1472
1471
(:*:)
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
1475
1474
1476
1475
--------------------------------------------------------------------------------
1477
1476
0 commit comments