Change the way that serialise is guarded from inclusion

Fixes #312
This commit is contained in:
John Wiegley 2018-05-11 12:15:18 -07:00
parent eef2ec2512
commit b60a15dc0d
No known key found for this signature in database
GPG key ID: C144D8F4F19FE630
4 changed files with 20 additions and 20 deletions

View file

@ -6,7 +6,7 @@
module Nix.Atoms where
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
import Codec.Serialise
#endif
import Control.DeepSeq
@ -31,7 +31,7 @@ data NAtom
deriving (Eq, Ord, Generic, Typeable, Data, Show, Read, NFData,
Hashable)
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise NAtom
#endif

View file

@ -13,7 +13,7 @@ import Nix.Expr.Types.Annotated
import qualified Data.Compact as C
import qualified Data.Compact.Serialize as C
#endif
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
import qualified Codec.Serialise as S
#endif
@ -25,7 +25,7 @@ readCache path = do
Left err -> error $ "Error reading cache file: " ++ err
Right expr -> return $ C.getCompact expr
#else
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
eres <- S.deserialiseOrFail <$> BS.readFile path
case eres of
Left err -> error $ "Error reading cache file: " ++ show err
@ -40,7 +40,7 @@ writeCache path expr =
#ifdef USE_COMPACT
C.writeCompact path =<< C.compact expr
#else
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
BS.writeFile path (S.serialise expr)
#else
error "writeCache not implemented for this platform"

View file

@ -27,7 +27,7 @@
-- | The nix expression type and supporting types.
module Nix.Expr.Types where
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
import Codec.Serialise (Serialise)
import qualified Codec.Serialise as Ser
#endif
@ -147,7 +147,7 @@ instance Hashable1 NExprF
instance NFData1 NExprF
#endif
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise r => Serialise (NExprF r)
#endif
@ -172,7 +172,7 @@ instance Lift (Fix NExprF) where
-- | The monomorphic expression type is a fixed point of the polymorphic one.
type NExpr = Fix NExprF
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise NExpr
#endif
@ -198,7 +198,7 @@ instance Hashable1 Binding
instance NFData1 Binding
#endif
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise r => Serialise (Binding r)
#endif
@ -222,7 +222,7 @@ instance Hashable1 Params
instance NFData1 Params
#endif
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise r => Serialise (Params r)
#endif
@ -255,7 +255,7 @@ instance Hashable2 Antiquoted where
instance NFData v => NFData1 (Antiquoted v)
#endif
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance (Serialise v, Serialise r) => Serialise (Antiquoted v r)
#endif
@ -281,7 +281,7 @@ instance Hashable1 NString
instance NFData1 NString
#endif
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise r => Serialise (NString r)
#endif
@ -315,7 +315,7 @@ data NKeyName r
deriving (Eq, Ord, Generic, Typeable, Data, Show, Read, NFData,
Hashable)
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise r => Serialise (NKeyName r)
instance Serialise Pos where
@ -399,7 +399,7 @@ data NUnaryOp = NNeg | NNot
deriving (Eq, Ord, Generic, Typeable, Data, Show, Read, NFData,
Hashable)
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise NUnaryOp
#endif
@ -424,7 +424,7 @@ data NBinaryOp
deriving (Eq, Ord, Generic, Typeable, Data, Show, Read, NFData,
Hashable)
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise NBinaryOp
#endif

View file

@ -21,7 +21,7 @@ module Nix.Expr.Types.Annotated
, SourcePos(..), unPos, mkPos
)where
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
import Codec.Serialise
#endif
import Control.DeepSeq
@ -56,7 +56,7 @@ data SrcSpan = SrcSpan
deriving (Ord, Eq, Generic, Typeable, Data, Show, NFData,
Hashable)
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise SrcSpan
#endif
@ -75,7 +75,7 @@ data Ann ann a = Ann
instance Hashable ann => Hashable1 (Ann ann)
#endif
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance (Serialise ann, Serialise a) => Serialise (Ann ann a)
#endif
@ -114,7 +114,7 @@ instance (NFData (f (g a)), NFData (g a)) => NFData (Compose f g a)
instance NFData NExprLoc
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise NExprLoc
#endif
@ -130,7 +130,7 @@ instance Binary NExprLoc
instance ToJSON SrcSpan
instance FromJSON SrcSpan
#if MIN_VERSION_serialise(0, 2, 0)
#ifdef MIN_VERSION_serialise
instance Serialise r => Serialise (Compose (Ann SrcSpan) NExprF r) where
encode (Compose (Ann ann a)) = encode ann <> encode a
decode = (Compose .) . Ann <$> decode <*> decode