Skip to content

Commit 73d6505

Browse files
committed
treewide: rm #ifdef MIN_VERSION_serialise guards
This type of #ifdef use is undocumented. It can be explained as IF Cabal env does not load/link the package, then Cabal does not provides this variable `MIN_VERSION_serialise` So this expression determines is `serialise` package provided by Cabal. b60a15d Which was done to not load serialize for GHCJS build: ba0dc19 (look at the `.cabal` `!impl` `GHCJS` switch) So this macros can be reduced now.
1 parent 3d3b509 commit 73d6505

File tree

4 files changed

+0
-46
lines changed

4 files changed

+0
-46
lines changed

src/Nix/Atoms.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,7 @@
33

44
module Nix.Atoms where
55

6-
#ifdef MIN_VERSION_serialise
76
import Codec.Serialise ( Serialise )
8-
#endif
97

108
import Data.Data ( Data)
119
import Data.Fixed ( mod' )
@@ -48,9 +46,7 @@ data NAtom
4846
, Hashable
4947
)
5048

51-
#ifdef MIN_VERSION_serialise
5249
instance Serialise NAtom
53-
#endif
5450

5551
instance Binary NAtom
5652
instance ToJSON NAtom

src/Nix/Cache.hs

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -15,9 +15,7 @@ import Nix.Expr.Types.Annotated
1515
import qualified Data.Compact as C
1616
import qualified Data.Compact.Serialize as C
1717
#endif
18-
#ifdef MIN_VERSION_serialise
1918
import qualified Codec.Serialise as S
20-
#endif
2119

2220
readCache :: FilePath -> IO NExprLoc
2321
readCache path = do
@@ -28,25 +26,17 @@ readCache path = do
2826
(\ expr -> pure $ C.getCompact expr)
2927
eres
3028
#else
31-
#ifdef MIN_VERSION_serialise
3229
eres <- S.deserialiseOrFail <$> BS.readFile path
3330
either
3431
(\ err -> fail $ "Error reading cache file: " <> show err)
3532
pure
3633
eres
37-
#else
38-
fail "readCache not implemented for this platform"
39-
#endif
4034
#endif
4135

4236
writeCache :: FilePath -> NExprLoc -> IO ()
4337
writeCache path expr =
4438
#ifdef USE_COMPACT
4539
C.writeCompact path =<< C.compact expr
4640
#else
47-
#ifdef MIN_VERSION_serialise
4841
BS.writeFile path (S.serialise expr)
49-
#else
50-
fail "writeCache not implemented for this platform"
51-
#endif
5242
#endif

src/Nix/Expr/Types.hs

Lines changed: 0 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -19,10 +19,8 @@
1919
-- <https://web.archive.org/web/20201112031804/https://alessandrovermeulen.me/2013/07/13/the-difference-between-shallow-and-deep-embedding/>
2020
module Nix.Expr.Types where
2121

22-
#ifdef MIN_VERSION_serialise
2322
import qualified Codec.Serialise as Serialise
2423
import Codec.Serialise ( Serialise )
25-
#endif
2624
import Control.DeepSeq
2725
import Data.Aeson
2826
import Data.Aeson.TH
@@ -91,9 +89,7 @@ instance NFData1 Binding
9189

9290
instance Hashable1 Binding
9391

94-
#ifdef MIN_VERSION_serialise
9592
instance Serialise r => Serialise (Binding r)
96-
#endif
9793

9894

9995
-- ** @Params@
@@ -122,9 +118,7 @@ instance Hashable1 Params
122118

123119
instance NFData1 Params
124120

125-
#ifdef MIN_VERSION_serialise
126121
instance Serialise r => Serialise (Params r)
127-
#endif
128122

129123
instance IsString (Params r) where
130124
fromString = Param . fromString
@@ -163,9 +157,7 @@ instance Hashable2 Antiquoted where
163157

164158
instance NFData v => NFData1 (Antiquoted v)
165159

166-
#ifdef MIN_VERSION_serialise
167160
instance (Serialise v, Serialise r) => Serialise (Antiquoted v r)
168-
#endif
169161

170162

171163
-- ** @NString@
@@ -198,9 +190,7 @@ instance Hashable1 NString
198190

199191
instance NFData1 NString
200192

201-
#ifdef MIN_VERSION_serialise
202193
instance Serialise r => Serialise (NString r)
203-
#endif
204194

205195
-- | For the the 'IsString' instance, we use a plain doublequoted string.
206196
instance IsString (NString r) where
@@ -240,7 +230,6 @@ data NKeyName r
240230
-- > StaticKey "x" ~ x
241231
deriving (Eq, Ord, Generic, Typeable, Data, Show, Read, NFData, Hashable)
242232

243-
#ifdef MIN_VERSION_serialise
244233
instance Serialise r => Serialise (NKeyName r)
245234

246235
instance Serialise Pos where
@@ -257,7 +246,6 @@ instance Serialise SourcePos where
257246
Serialise.decode
258247
Serialise.decode
259248
Serialise.decode
260-
#endif
261249

262250
instance Hashable Pos where
263251
hashWithSalt salt = hashWithSalt salt . unPos
@@ -345,9 +333,7 @@ data NUnaryOp
345333
deriving (Eq, Ord, Enum, Bounded, Generic, Typeable, Data, Show, Read,
346334
NFData, Hashable)
347335

348-
#ifdef MIN_VERSION_serialise
349336
instance Serialise NUnaryOp
350-
#endif
351337

352338

353339
-- ** @NBinaryOp@
@@ -375,9 +361,7 @@ data NBinaryOp
375361
deriving (Eq, Ord, Enum, Bounded, Generic, Typeable, Data, Show, Read,
376362
NFData, Hashable)
377363

378-
#ifdef MIN_VERSION_serialise
379364
instance Serialise NBinaryOp
380-
#endif
381365

382366

383367
-- ** @NRecordType@
@@ -390,9 +374,7 @@ data NRecordType
390374
deriving (Eq, Ord, Enum, Bounded, Generic, Typeable, Data, Show, Read,
391375
NFData, Hashable)
392376

393-
#ifdef MIN_VERSION_serialise
394377
instance Serialise NRecordType
395-
#endif
396378

397379
-- * @NExprF@ - Nix expressions, base functor
398380

@@ -487,9 +469,7 @@ data NExprF r
487469

488470
instance NFData1 NExprF
489471

490-
#ifdef MIN_VERSION_serialise
491472
instance Serialise r => Serialise (NExprF r)
492-
#endif
493473

494474
-- | We make an `IsString` for expressions, where the string is interpreted
495475
-- as an identifier. This is the most common use-case...
@@ -509,9 +489,7 @@ instance Hashable1 NExprF
509489
-- | The monomorphic expression type is a fixed point of the polymorphic one.
510490
type NExpr = Fix NExprF
511491

512-
#ifdef MIN_VERSION_serialise
513492
instance Serialise NExpr
514-
#endif
515493

516494
instance TH.Lift NExpr where
517495
lift =

src/Nix/Expr/Types/Annotated.hs

Lines changed: 0 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -16,9 +16,7 @@ module Nix.Expr.Types.Annotated
1616
)
1717
where
1818

19-
#ifdef MIN_VERSION_serialise
2019
import Codec.Serialise
21-
#endif
2220
import Control.DeepSeq
2321
import Data.Aeson ( ToJSON(..)
2422
, FromJSON(..)
@@ -63,9 +61,7 @@ instance Binary SrcSpan
6361
instance ToJSON SrcSpan
6462
instance FromJSON SrcSpan
6563

66-
#ifdef MIN_VERSION_serialise
6764
instance Serialise SrcSpan
68-
#endif
6965

7066
-- * data type @Ann@
7167

@@ -123,31 +119,25 @@ $(deriveShow2 ''Ann)
123119
$(deriveJSON1 defaultOptions ''Ann)
124120
$(deriveJSON2 defaultOptions ''Ann)
125121

126-
#ifdef MIN_VERSION_serialise
127122
instance (Serialise ann, Serialise a) => Serialise (Ann ann a)
128-
#endif
129123

130124
-- ** @NExprLoc{,F}@ - annotated Nix expression
131125

132126
type NExprLocF = AnnF SrcSpan NExprF
133127

134-
#ifdef MIN_VERSION_serialise
135128
instance Serialise r => Serialise (NExprLocF r) where
136129
encode (AnnFP ann a) = encode ann <> encode a
137130
decode =
138131
liftA2 AnnFP
139132
decode
140133
decode
141-
#endif
142134

143135
instance Binary r => Binary (NExprLocF r)
144136

145137
-- | Annotated Nix expression (each subexpression direct to its source location).
146138
type NExprLoc = Fix NExprLocF
147139

148-
#ifdef MIN_VERSION_serialise
149140
instance Serialise NExprLoc
150-
#endif
151141

152142
instance Binary NExprLoc
153143

0 commit comments

Comments
 (0)