picnoir
/
hnix
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

This commit is contained in:
John Wiegley 2018-04-11 17:59:42 -07:00
parent 1604028f0f
commit 22175aa927
7 changed files with 84 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
default.nix
View File

@ -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 {

7
hnix.cabal
View File

@ -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

48
main/Main.hs
View File

@ -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.Compact.Serialize as C
import qualified Data.ByteString.Lazy as BS
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"
<> help "Write out the expression tree as a compact region")
( long "cache"
<> 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
cx <- C.compact expr
| cache opts ->
#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 ->

2
package.yaml
View File

@ -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:

6
src/Nix/Atoms.hs
View File

@ -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)
instance NFData NAtom
deriving (Eq, Ord, Generic, Typeable, Data, Show, NFData, Serialise)
class ToAtom t where
toAtom :: t -> NAtom

36
src/Nix/Expr/Types.hs
View File

@ -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)
get = mkPos <$> get
put x = Bin.put (unPos x)
get = mkPos <$> Bin.get
instance Binary SourcePos
instance Binary a => Binary (NKeyName a)
instance Binary a => Binary (Params a)

10
src/Nix/Expr/Types/Annotated.hs
View File

@ -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)