Use the serialise library on non-Linux systems, compact on Linux

default.nix

@@ -21,6 +21,9 @@ let
 
   pkg = haskellPackages.developPackage {
     root = ./.;
+    overrides = self: super: {
+      serialise = pkgs.haskell.lib.dontCheck super.serialise;
+    };
     source-overrides = {
       # Use a particular commit from github
       insert-ordered-containers = pkgs.fetchFromGitHub {

hnix.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: e96c99f7855d271377ef923e541a2cbb9968e1e1a6349e317c85985118ba94ad
+-- hash: 13b58b4fb9f715dd28ba6e47cb5feeb0da553ac1b16b356677c580f8b71f70e6
 
 name:           hnix
 version:        0.5.0
@@ -82,6 +82,7 @@ library
     , regex-tdfa-text
     , scientific
     , semigroups >=0.18 && <0.19
+    , serialise
     , split
     , syb
     , template-haskell
@@ -104,6 +105,7 @@ executable hnix
   build-depends:
       ansi-wl-pprint
     , base >=4.9 && <5
+    , bytestring
     , compact
     , containers
     , data-fix
@@ -113,6 +115,7 @@ executable hnix
     , hnix
     , mtl
     , optparse-applicative
+    , serialise
     , template-haskell
     , text
     , transformers
@@ -147,6 +150,7 @@ test-suite hnix-tests
     , interpolate
     , mtl
     , process
+    , serialise
     , split
     , tasty
     , tasty-hunit
@@ -179,6 +183,7 @@ benchmark hnix-benchmarks
     , filepath
     , hnix
     , mtl
+    , serialise
     , template-haskell
     , text
     , transformers

main/Main.hs

@@ -1,15 +1,19 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 -- {-# LANGUAGE QuasiQuotes #-}
 
+#ifdef __linux__
+#define USE_COMPACT 1
+#endif
+
 module Main where
 
 import           Control.DeepSeq
 import qualified Control.Exception as Exc
 import           Control.Monad
 import           Control.Monad.ST
-import qualified Data.Compact as C
+import qualified Data.ByteString.Lazy as BS
-import qualified Data.Compact.Serialize as C
 import           Data.Text (Text, pack)
 import qualified Data.Text.IO as Text
 import qualified Nix
@@ -24,13 +28,20 @@ import           System.IO
 import           System.FilePath
 import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
 
+#ifdef USE_COMPACT
+import qualified Data.Compact as C
+import qualified Data.Compact.Serialize as C
+#else
+import qualified Codec.Serialise as S
+#endif
+
 data Options = Options
     { verbose      :: Bool
     , debug        :: Bool
     , evaluate     :: Bool
     , check        :: Bool
     , readFrom     :: Maybe FilePath
-    , compact      :: Bool
+    , cache        :: Bool
     , parse        :: Bool
     , parseOnly    :: Bool
     , ignoreErrors :: Bool
@@ -59,10 +70,10 @@ mainOptions = Options
          <> help "Whether to check for syntax errors after parsing")
     <*> optional (strOption
         (   long "read"
-         <> help "Read in an expression tree from a compacted file"))
+         <> help "Read in an expression tree from a binary cache"))
     <*> switch
-        (   long "compact"
+        (   long "cache"
-         <> help "Write out the expression tree as a compact region")
+         <> help "Write out the parsed expression tree to a binary cache")
     <*> switch
         (   long "parse"
          <> help "Whether to parse the file (also the default right now)")
@@ -98,12 +109,21 @@ main = do
     opts <- execParser optsDef
     case readFrom opts of
         Just path -> do
+#ifdef USE_COMPACT
             eres <- C.unsafeReadCompact path
             case eres of
-                Left err -> error $ "Error reading compact file: " ++ err
+                Left err -> error $ "Error reading cache file: " ++ err
                 Right expr -> do
                     let file = addExtension (dropExtension path) "nix"
                     process opts (Just file) (C.getCompact expr)
+#else
+            eres <- S.deserialiseOrFail <$> BS.readFile path
+            case eres of
+                Left err -> error $ "Error reading cache file: " ++ show err
+                Right expr -> do
+                    let file = addExtension (dropExtension path) "nix"
+                    process opts (Just file) expr
+#endif
         Nothing -> case expression opts of
             Just s -> handleResult opts Nothing (parseNixTextLoc s)
             Nothing  -> case fromFile opts of
@@ -157,13 +177,21 @@ main = do
                  putStrLn . printNix =<< Nix.evalLoc mpath expr
            | debug opts ->
                  print $ stripAnnotation expr
-           | compact opts -> do
+           | cache opts ->
-                 cx <- C.compact expr
+#ifdef USE_COMPACT
+                 do cx <- C.compact expr
+                    case mpath of
+                        Nothing -> return ()
+                        Just path -> do
+                            let file = addExtension (dropExtension path) "nixc"
+                            C.writeCompact file cx
+#else
                  case mpath of
                      Nothing -> return ()
                      Just path -> do
                          let file = addExtension (dropExtension path) "nixc"
-                         C.writeCompact file cx
+                         BS.writeFile file (S.serialise expr)
+#endif
            | parseOnly opts ->
                  void $ Exc.evaluate $ force expr
            | otherwise ->

package.yaml

@@ -23,6 +23,7 @@ dependencies:
   - exceptions
   - filepath
   - mtl
+  - serialise
   - template-haskell
   - text
   - transformers
@@ -65,6 +66,7 @@ executables:
     main: Main.hs
     dependencies:
       - hnix
+      - bytestring
       - optparse-applicative
 
 tests:

src/Nix/Atoms.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE LambdaCase #-}
@@ -5,6 +6,7 @@
 
 module Nix.Atoms where
 
+import Codec.Serialise
 import Control.DeepSeq
 import Data.Data
 import Data.HashMap.Strict (HashMap)
@@ -26,9 +28,7 @@ data NAtom
   | NNull
   -- | URIs, which are just string literals, but do not need quotes.
   | NUri Text
-  deriving (Eq, Ord, Generic, Typeable, Data, Show)
+  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData, Serialise)
-
-instance NFData NAtom
 
 class ToAtom t where
   toAtom :: t -> NAtom

src/Nix/Expr/Types.hs

@@ -23,12 +23,16 @@
 -- | The nix expression type and supporting types.
 module Nix.Expr.Types where
 
+import           Codec.Serialise (Serialise)
+import qualified Codec.Serialise as Ser
 import           Control.DeepSeq
-import           Data.Binary
+import           Data.Binary (Binary)
+import qualified Data.Binary as Bin
 import           Data.Data
 import           Data.Eq.Deriving
 import           Data.Fix
 import           Data.Functor.Classes
+import           Data.Monoid
 import           Data.Text (Text, pack, unpack)
 import           Data.Traversable
 import           GHC.Exts
@@ -37,8 +41,8 @@ import           Language.Haskell.TH.Syntax
 import           Nix.Atoms
 import           Nix.Parser.Library (SourcePos(..))
 import           Nix.Utils
-import           Text.Show.Deriving
 import           Text.Megaparsec.Pos
+import           Text.Show.Deriving
 import           Type.Reflection (eqTypeRep)
 import qualified Type.Reflection as Reflection
 
@@ -90,7 +94,7 @@ data NExprF r
   | NAssert !r !r
   -- ^ Assert that the first returns true before evaluating the second.
   deriving (Ord, Eq, Generic, Generic1, Typeable, Data, Functor,
-            Foldable, Traversable, Show, NFData, NFData1)
+            Foldable, Traversable, Show, NFData, NFData1, Serialise)
 
 -- | We make an `IsString` for expressions, where the string is interpreted
 -- as an identifier. This is the most common use-case...
@@ -115,7 +119,7 @@ data Binding r
   -- ^ Using a name already in scope, such as @inherit x;@ which is shorthand
   -- for @x = x;@ or @inherit (x) y;@ which means @y = x.y;@.
   deriving (Generic, Generic1, Typeable, Data, Ord, Eq, Functor,
-            Foldable, Traversable, Show, NFData, NFData1)
+            Foldable, Traversable, Show, NFData, NFData1, Serialise)
 
 -- | @Params@ represents all the ways the formal parameters to a
 -- function can be represented.
@@ -127,7 +131,7 @@ data Params r
   -- bind to the set in the function body. The bool indicates whether it is
   -- variadic or not.
   deriving (Ord, Eq, Generic, Generic1, Typeable, Data, Functor, Show,
-            Foldable, Traversable, NFData, NFData1)
+            Foldable, Traversable, NFData, NFData1, Serialise)
 
 -- This uses an association list because nix XML serialization preserves the
 -- order of the param set.
@@ -140,7 +144,7 @@ instance IsString (Params r) where
 -- antiquoted (surrounded by ${...}) or plain (not antiquoted).
 data Antiquoted (v :: *) (r :: *) = Plain !v | EscapedNewline | Antiquoted !r
   deriving (Ord, Eq, Generic, Generic1, Typeable, Data, Functor,
-            Foldable, Traversable, Show, NFData, NFData1)
+            Foldable, Traversable, Show, NFData, NFData1, Serialise)
 
 -- | An 'NString' is a list of things that are either a plain string
 -- or an antiquoted expression. After the antiquotes have been evaluated,
@@ -154,7 +158,7 @@ data NString r
   --   their indentation will be stripped, but the amount stripped is
   --   remembered.
   deriving (Eq, Ord, Generic, Generic1, Typeable, Data, Functor,
-            Foldable, Traversable, Show, NFData, NFData1)
+            Foldable, Traversable, Show, NFData, NFData1, Serialise)
 
 -- | For the the 'IsString' instance, we use a plain doublequoted string.
 instance IsString (NString r) where
@@ -183,7 +187,15 @@ instance IsString (NString r) where
 data NKeyName r
   = DynamicKey !(Antiquoted (NString r) r)
   | StaticKey !VarName !(Maybe SourcePos)
-  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
+  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData, Serialise)
+
+instance Serialise Pos where
+    encode x = Ser.encode (unPos x)
+    decode = mkPos <$> Ser.decode
+
+instance Serialise SourcePos where
+    encode (SourcePos f l c) = Ser.encode f <> Ser.encode l <> Ser.encode c
+    decode = SourcePos <$> Ser.decode <*> Ser.decode <*> Ser.decode
 
 instance Generic1 NKeyName where
   type Rep1 NKeyName = NKeyName -- jww (2018-04-09): wrong
@@ -236,7 +248,7 @@ type NAttrPath r = [NKeyName r]
 
 -- | There are two unary operations: logical not and integer negation.
 data NUnaryOp = NNeg | NNot
-  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
+  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData, Serialise)
 
 -- | Binary operators expressible in the nix language.
 data NBinaryOp
@@ -256,7 +268,7 @@ data NBinaryOp
   | NDiv     -- ^ Division (/)
   | NConcat  -- ^ List concatenation (++)
   | NApp     -- ^ Apply a function to an argument.
-  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData)
+  deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData, Serialise)
 
 -- | Get the name out of the parameter (there might be none).
 paramName :: Params r -> Maybe VarName
@@ -281,8 +293,8 @@ instance (Binary v, Binary a) => Binary (Antiquoted v a)
 instance Binary a => Binary (NString a)
 instance Binary a => Binary (Binding a)
 instance Binary Pos where
-    put x = put (unPos x)
+    put x = Bin.put (unPos x)
-    get = mkPos <$> get
+    get = mkPos <$> Bin.get
 instance Binary SourcePos
 instance Binary a => Binary (NKeyName a)
 instance Binary a => Binary (Params a)

src/Nix/Expr/Types/Annotated.hs

@@ -19,6 +19,7 @@ module Nix.Expr.Types.Annotated
   , SourcePos(..), unPos
   )where
 
+import Codec.Serialise
 import Control.DeepSeq
 import Data.Data
 import Data.Fix
@@ -36,7 +37,7 @@ import Text.Megaparsec (unPos)
 data SrcSpan = SrcSpan{ spanBegin :: SourcePos
                       , spanEnd   :: SourcePos
                       }
-  deriving (Ord, Eq, Generic, Typeable, Data, Show, NFData)
+  deriving (Ord, Eq, Generic, Typeable, Data, Show, NFData, Serialise)
 
 -- | A type constructor applied to a type along with an annotation
 --
@@ -46,7 +47,7 @@ data Ann ann a = Ann{ annotation :: ann
                     , annotated  :: a
                     }
   deriving (Ord, Eq, Data, Generic, Generic1, Typeable, Functor,
-            Foldable, Traversable, Read, Show, NFData, NFData1)
+            Foldable, Traversable, Read, Show, NFData, NFData1, Serialise)
 
 $(deriveShow1 ''Ann)
 
@@ -65,6 +66,11 @@ type NExprLocF = AnnF SrcSpan NExprF
 type NExprLoc = Fix NExprLocF
 
 instance NFData NExprLoc
+instance Serialise NExprLoc
+
+instance Serialise r => Serialise (Compose (Ann SrcSpan) NExprF r) where
+    encode (Compose (Ann ann a)) = encode ann <> encode a
+    decode = (Compose .) . Ann <$> decode <*> decode
 
 pattern AnnE :: forall ann (g :: * -> *). ann
              -> g (Fix (Compose (Ann ann) g)) -> Fix (Compose (Ann ann) g)