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

Normalize import statements, add option parsing

This commit is contained in:
John Wiegley 2018-03-27 21:59:27 -07:00
parent 1e0e47d064
commit 3a29249e43
18 changed files with 327 additions and 295 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Nix/Atoms.hs
View File

@ -1,10 +1,9 @@
module Nix.Atoms where
import Prelude
import Data.Text (Text, pack)
import GHC.Generics
import Data.Data
import Data.HashMap.Strict (HashMap)
import Data.Text (Text, pack)
import GHC.Generics
-- | Atoms are values that evaluate to themselves. This means that
-- they appear in both the parsed AST (in the form of literals) and

1
Nix/Builtins.hs
View File

@ -7,7 +7,6 @@ import qualified Data.Text as Text
import Nix.Atoms
import Nix.Eval
import Nix.Expr (NExpr)
import Prelude
-- | Evaluate a nix expression in the default context
evalTopLevelExpr :: NExpr -> NValue

284
Nix/Eval.hs
View File

@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
module Nix.Eval where
@ -9,6 +10,7 @@ import Control.Monad
import Data.Align.Key
import Data.Fix
import Data.Foldable (foldl')
import Data.Functor.Identity
import Data.List (intercalate)
import qualified Data.Map.Lazy as Map
import Data.Maybe (fromMaybe)
@ -21,7 +23,6 @@ import GHC.Generics
import Nix.Atoms
import Nix.Expr
import Nix.StringOperations (runAntiquoted)
import Prelude
type DList a = Endo [a]
@ -128,135 +129,166 @@ buildArgument params arg = case params of
(&) :: a -> (a -> c) -> c
(&) = flip ($)
-- | adi is Abstracting Definitional Interpreters:
--
-- https://arxiv.org/abs/1707.04755
--
-- Essentially, it does for evaluation what recursion schemes do for
-- representation: allows threading layers through existing structure, only
-- in this case through behavior.
adi :: (Monoid b, Applicative s, Traversable t)
=> (t a -> a)
-> ((Fix t -> (b, s a)) -> Fix t -> (b, s a))
-> Fix t -> (b, s a)
adi f g = g (go . traverse (adi f g) . unFix)
where
go = fmap (fmap f . sequenceA)
adiM :: (Monoid b, Applicative s, Traversable s, Traversable t, Monad m)
=> (t a -> m a)
-> ((Fix t -> m (b, s a)) -> Fix t -> m (b, s a))
-> Fix t -> m (b, s a)
adiM f g = g ((go <=< traverse (adiM f g)) . unFix)
where
go = traverse (traverse f . sequenceA) . sequenceA
-- | Evaluate an nix expression, with a given ValueSet as environment
evalExpr :: NExpr -> PendingEval
evalExpr = cata phi
phi :: NExprF PendingEval -> PendingEval
phi (NSym var) = fromMaybe err . Map.lookup var
where err = error ("Undefined variable: " ++ show var)
phi (NConstant x) = const $ Fix $ NVConstant x
phi (NStr str) = evalString str
phi (NLiteralPath p) = const $ Fix $ NVLiteralPath p
phi (NEnvPath p) = const $ Fix $ NVEnvPath p
phi (NUnary op arg) = \env -> arg env & \case
Fix (NVConstant c) -> Fix $ NVConstant $ case (op, c) of
(NNeg, NInt i) -> NInt (-i)
(NNot, NBool b) -> NBool (not b)
_ -> error $ "unsupported argument type for unary operator " ++ show op
_ -> error "argument to unary operator must evaluate to an atomic type"
phi (NBinary op larg rarg) = \env ->
let Fix lval = larg env
Fix rval = rarg env
unsupportedTypes =
"unsupported argument types for binary operator "
++ show (lval, op, rval)
in case (lval, rval) of
(NVConstant lc, NVConstant rc) -> Fix $ NVConstant $ case (op, lc, rc) of
(NEq, l, r) -> NBool $ l == r
(NNEq, l, r) -> NBool $ l /= r
(NLt, l, r) -> NBool $ l < r
(NLte, l, r) -> NBool $ l <= r
(NGt, l, r) -> NBool $ l > r
(NGte, l, r) -> NBool $ l >= r
(NAnd, NBool l, NBool r) -> NBool $ l && r
(NOr, NBool l, NBool r) -> NBool $ l || r
(NImpl, NBool l, NBool r) -> NBool $ not l || r
(NPlus, NInt l, NInt r) -> NInt $ l + r
(NMinus, NInt l, NInt r) -> NInt $ l - r
(NMult, NInt l, NInt r) -> NInt $ l * r
(NDiv, NInt l, NInt r) -> NInt $ l `div` r
_ -> error unsupportedTypes
(NVStr ls lc, NVStr rs rc) -> case op of
NPlus -> Fix $ NVStr (ls `mappend` rs) (lc `mappend` rc)
_ -> error unsupportedTypes
(NVSet ls, NVSet rs) -> case op of
NUpdate -> Fix $ NVSet $ rs `Map.union` ls
_ -> error unsupportedTypes
(NVList ls, NVList rs) -> case op of
NConcat -> Fix $ NVList $ ls ++ rs
_ -> error unsupportedTypes
(NVLiteralPath ls, NVLiteralPath rs) -> case op of
NPlus -> Fix $ NVLiteralPath $ ls ++ rs -- TODO: Canonicalise path
_ -> error unsupportedTypes
(NVLiteralPath ls, NVStr rs rc) -> case op of
NPlus -> Fix $ NVStr (Text.pack ls `mappend` rs) rc -- TODO: Canonicalise path
_ -> error unsupportedTypes
_ -> error unsupportedTypes
phi (NSelect aset attr alternative) = go where
go env =
let aset' = aset env
ks = evalSelector True attr env
in case extract aset' ks of
Just v -> v
Nothing -> case alternative of
Just v -> v env
Nothing -> error $ "could not look up attribute '"
++ intercalate "." (map show ks) ++ "' in value " ++ show aset'
extract (Fix (NVSet s)) (k:ks) = case Map.lookup k s of
Just v -> extract v ks
Nothing -> Nothing
extract _ (_:_) = Nothing
extract v [] = Just v
phi (NHasAttr aset attr) = \env -> aset env & \case
Fix (NVSet s) -> evalSelector True attr env & \case
[keyName] -> Fix $ NVConstant $ NBool $ keyName `Map.member` s
_ -> error "attribute name argument to hasAttr is not a single-part name"
_ -> error "argument to hasAttr has wrong type"
phi (NList l) = \env ->
Fix . NVList $ map ($ env) l
phi (NSet binds) =
Fix . NVSet . evalBinds True binds
phi (NRecSet binds) = \env ->
let mergedEnv = evaledBinds `Map.union` env
evaledBinds = evalBinds True binds mergedEnv
in Fix . NVSet $ evaledBinds
phi (NLet binds e) = \env ->
let mergedEnv = evaledBinds `Map.union` env
evaledBinds = evalBinds True binds mergedEnv
in e mergedEnv
phi (NIf cond t f) = \env ->
let Fix cval = cond env
in case cval of
NVConstant (NBool True) -> t env
NVConstant (NBool False) -> f env
_ -> error "condition must be a boolean"
phi (NWith scope e) = \env ->
let s = scope env
in case s of
(Fix (NVSet scope')) -> e $ Map.union scope' env
_ -> error "scope must be a set in with statement"
phi (NAssert cond e) = \env ->
let Fix cond' = cond env
in case cond' of
(NVConstant (NBool True)) -> e env
(NVConstant (NBool False)) -> error "assertion failed"
_ -> error "assertion condition must be boolean"
phi (NApp fun x) = \env ->
let fun' = fun env
in case fun' of
Fix (NVFunction params f) ->
f (buildArgument params (x env))
Fix (NVBuiltin _ f) -> f (x env)
_ -> error "Attempt to call non-function"
phi (NAbs a b) = \env ->
-- It is the environment at the definition site, not the call site,
-- that needs to be used when evaluation the body and the default
-- arguments
let extend f env' = f (env' `Map.union` env)
in Fix $ NVFunction (fmap extend a) (extend b)
tracingExprEval :: NExpr -> IO PendingEval
tracingExprEval =
fmap (runIdentity . snd) . adiM @() (pure <$> phi) psi
where
phi :: NExprF PendingEval -> PendingEval
phi (NSym var) = fromMaybe err . Map.lookup var
where err = error ("Undefined variable: " ++ show var)
phi (NConstant x) = const $ Fix $ NVConstant x
phi (NStr str) = evalString str
phi (NLiteralPath p) = const $ Fix $ NVLiteralPath p
phi (NEnvPath p) = const $ Fix $ NVEnvPath p
phi (NUnary op arg) = \env -> arg env & \case
Fix (NVConstant c) -> Fix $ NVConstant $ case (op, c) of
(NNeg, NInt i) -> NInt (-i)
(NNot, NBool b) -> NBool (not b)
_ -> error $ "unsupported argument type for unary operator " ++ show op
_ -> error "argument to unary operator must evaluate to an atomic type"
phi (NBinary op larg rarg) = \env ->
let Fix lval = larg env
Fix rval = rarg env
unsupportedTypes =
"unsupported argument types for binary operator "
++ show (lval, op, rval)
in case (lval, rval) of
(NVConstant lc, NVConstant rc) -> Fix $ NVConstant $ case (op, lc, rc) of
(NEq, l, r) -> NBool $ l == r
(NNEq, l, r) -> NBool $ l /= r
(NLt, l, r) -> NBool $ l < r
(NLte, l, r) -> NBool $ l <= r
(NGt, l, r) -> NBool $ l > r
(NGte, l, r) -> NBool $ l >= r
(NAnd, NBool l, NBool r) -> NBool $ l && r
(NOr, NBool l, NBool r) -> NBool $ l || r
(NImpl, NBool l, NBool r) -> NBool $ not l || r
(NPlus, NInt l, NInt r) -> NInt $ l + r
(NMinus, NInt l, NInt r) -> NInt $ l - r
(NMult, NInt l, NInt r) -> NInt $ l * r
(NDiv, NInt l, NInt r) -> NInt $ l `div` r
_ -> error unsupportedTypes
(NVStr ls lc, NVStr rs rc) -> case op of
NPlus -> Fix $ NVStr (ls `mappend` rs) (lc `mappend` rc)
_ -> error unsupportedTypes
(NVSet ls, NVSet rs) -> case op of
NUpdate -> Fix $ NVSet $ rs `Map.union` ls
_ -> error unsupportedTypes
(NVList ls, NVList rs) -> case op of
NConcat -> Fix $ NVList $ ls ++ rs
_ -> error unsupportedTypes
(NVLiteralPath ls, NVLiteralPath rs) -> case op of
NPlus -> Fix $ NVLiteralPath $ ls ++ rs -- TODO: Canonicalise path
_ -> error unsupportedTypes
(NVLiteralPath ls, NVStr rs rc) -> case op of
NPlus -> Fix $ NVStr (Text.pack ls `mappend` rs) rc -- TODO: Canonicalise path
_ -> error unsupportedTypes
_ -> error unsupportedTypes
phi (NSelect aset attr alternative) = go where
go env =
let aset' = aset env
ks = evalSelector True attr env
in case extract aset' ks of
Just v -> v
Nothing -> case alternative of
Just v -> v env
Nothing -> error $ "could not look up attribute '"
++ intercalate "." (map show ks) ++ "' in value " ++ show aset'
extract (Fix (NVSet s)) (k:ks) = case Map.lookup k s of
Just v -> extract v ks
Nothing -> Nothing
extract _ (_:_) = Nothing
extract v [] = Just v
phi (NHasAttr aset attr) = \env -> aset env & \case
Fix (NVSet s) -> evalSelector True attr env & \case
[keyName] -> Fix $ NVConstant $ NBool $ keyName `Map.member` s
_ -> error "attribute name argument to hasAttr is not a single-part name"
_ -> error "argument to hasAttr has wrong type"
phi (NList l) = \env ->
Fix . NVList $ map ($ env) l
phi (NSet binds) =
Fix . NVSet . evalBinds True binds
phi (NRecSet binds) = \env ->
let mergedEnv = evaledBinds `Map.union` env
evaledBinds = evalBinds True binds mergedEnv
in Fix . NVSet $ evaledBinds
phi (NLet binds e) = \env ->
let mergedEnv = evaledBinds `Map.union` env
evaledBinds = evalBinds True binds mergedEnv
in e mergedEnv
phi (NIf cond t f) = \env ->
let Fix cval = cond env
in case cval of
NVConstant (NBool True) -> t env
NVConstant (NBool False) -> f env
_ -> error "condition must be a boolean"
phi (NWith scope e) = \env ->
let s = scope env
in case s of
(Fix (NVSet scope')) -> e $ Map.union scope' env
_ -> error "scope must be a set in with statement"
phi (NAssert cond e) = \env ->
let Fix cond' = cond env
in case cond' of
(NVConstant (NBool True)) -> e env
(NVConstant (NBool False)) -> error "assertion failed"
_ -> error "assertion condition must be boolean"
phi (NApp fun x) = \env ->
let fun' = fun env
in case fun' of
Fix (NVFunction params f) ->
f (buildArgument params (x env))
Fix (NVBuiltin _ f) -> f (x env)
_ -> error "Attempt to call non-function"
phi (NAbs a b) = \env ->
-- It is the environment at the definition site, not the call site,
-- that needs to be used when evaluation the body and the default
-- arguments
let extend f env' = f (env' `Map.union` env)
in Fix $ NVFunction (fmap extend a) (extend b)
psi k v@(Fix x) = do
putStrLn $ "Evaluating: " ++ show x
k v
evalString :: NString PendingEval -> PendingEval
evalString nstr env =

11
Nix/Expr/Shorthands.hs
View File

@ -4,13 +4,12 @@
-- 'Fix' wrapper.
module Nix.Expr.Shorthands where
import Prelude
import Data.Monoid
import Data.Text (Text)
import Data.Fix
import Data.Fix
import qualified Data.Map as Map
import Nix.Atoms
import Nix.Expr.Types
import Data.Monoid
import Data.Text (Text)
import Nix.Atoms
import Nix.Expr.Types
-- | Make an integer literal expression.
mkInt :: Integer -> NExpr

26
Nix/Expr/Types.hs
View File

@ -10,21 +10,17 @@
-- | The nix expression type and supporting types.
module Nix.Expr.Types where
import Control.Monad hiding (forM_, mapM, sequence)
import Data.Data
import Data.Eq.Deriving
import Data.Fix
import Data.Foldable
import Data.Functor.Classes (Eq1(..), Eq2(..), Show1(..), showsUnaryWith, liftShowsPrec2)
import Data.Map (Map, toList)
import Data.Text (Text, pack)
import Data.Traversable
import GHC.Exts
import GHC.Generics
import Nix.Atoms
import Prelude hiding (readFile, concat, concatMap, elem, mapM,
sequence, minimum, foldr)
import Text.Show.Deriving
import Data.Data
import Data.Eq.Deriving
import Data.Fix
import Data.Functor.Classes
import Data.Map (Map, toList)
import Data.Text (Text, pack)
import Data.Traversable
import GHC.Exts
import GHC.Generics
import Nix.Atoms
import Text.Show.Deriving
-- | The main nix expression type. This is polymorphic so that it can be made
-- a functor, which allows us to traverse expressions and map functions over

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

@ -16,18 +16,15 @@ module Nix.Expr.Types.Annotated
, Delta(..)
)where
import Control.Monad hiding (forM_, mapM, sequence)
import Data.Data
import Data.Fix
import Data.Function (on)
import Data.Functor.Compose
import Data.Semigroup
import GHC.Generics
import Nix.Expr.Types
import Nix.Parser.Library (Delta(..))
import Prelude hiding (concat, concatMap, elem, foldr,
mapM, minimum, readFile, sequence)
import Text.Show.Deriving
import Data.Data
import Data.Fix
import Data.Function (on)
import Data.Functor.Compose
import Data.Semigroup
import GHC.Generics
import Nix.Expr.Types
import Nix.Parser.Library (Delta(..))
import Text.Show.Deriving
-- | A location in a source file
data SrcSpan = SrcSpan{ spanBegin :: Delta
@ -42,7 +39,8 @@ data SrcSpan = SrcSpan{ spanBegin :: Delta
data Ann ann a = Ann{ annotation :: ann
, annotated :: a
}
deriving (Ord, Eq, Data, Generic, Typeable, Functor, Foldable, Traversable, Read, Show)
deriving (Ord, Eq, Data, Generic, Typeable, Functor,
Foldable, Traversable, Read, Show)
$(deriveShow1 ''Ann)
@ -60,6 +58,8 @@ type NExprLocF = AnnF SrcSpan NExprF
-- | A nix expression with source location at each subexpression.
type NExprLoc = Fix NExprLocF
pattern AnnE :: forall ann (g :: * -> *). ann
-> g (Fix (Compose (Ann ann) g)) -> Fix (Compose (Ann ann) g)
pattern AnnE ann a = Fix (Compose (Ann ann a))
stripAnnotation :: Functor f => Fix (AnnF ann f) -> Fix f
@ -67,24 +67,32 @@ stripAnnotation = ana (annotated . getCompose . unFix)
nApp :: NExprLoc -> NExprLoc -> NExprLoc
nApp e1@(AnnE s1 _) e2@(AnnE s2 _) = AnnE (s1 <> s2) (NApp e1 e2)
nApp _ _ = error "nApp: unexpected"
nUnary :: Ann SrcSpan NUnaryOp -> NExprLoc -> NExprLoc
nUnary (Ann s1 u) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NUnary u e1)
nUnary _ _ = error "nUnary: unexpected"
nBinary :: Ann SrcSpan NBinaryOp -> NExprLoc -> NExprLoc -> NExprLoc
nBinary (Ann s1 b) e1@(AnnE s2 _) e2@(AnnE s3 _) =
AnnE (s1 <> s2 <> s3) (NBinary b e1 e2)
nBinary _ _ _ = error "nBinary: unexpected"
nSelectLoc :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc -> NExprLoc
nSelectLoc :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> Maybe NExprLoc
-> NExprLoc
nSelectLoc e1@(AnnE s1 _) (Ann s2 ats) d = case d of
Nothing -> AnnE (s1 <> s2) (NSelect e1 ats Nothing)
Just (e2@(AnnE s3 _)) -> AnnE (s1 <> s2 <> s3) (NSelect e1 ats (Just e2))
_ -> error "nSelectLoc: unexpected"
nSelectLoc _ _ _ = error "nSelectLoc: unexpected"
nHasAttr :: NExprLoc -> Ann SrcSpan (NAttrPath NExprLoc) -> NExprLoc
nHasAttr e1@(AnnE s1 _) (Ann s2 ats) = AnnE (s1 <> s2) (NHasAttr e1 ats)
nHasAttr _ _ = error "nHasAttr: unexpected"
nAbs :: Ann SrcSpan (Params NExprLoc) -> NExprLoc -> NExprLoc
nAbs (Ann s1 ps) e1@(AnnE s2 _) = AnnE (s1 <> s2) (NAbs ps e1)
nAbs _ _ = error "nAbs: unexpected"
nStr :: Ann SrcSpan (NString NExprLoc) -> NExprLoc
nStr (Ann s1 s) = AnnE s1 (NStr s)

3
Nix/Parser.hs
View File

@ -17,11 +17,10 @@ import Control.Monad.IO.Class
import Data.Foldable hiding (concat)
import qualified Data.Map as Map
import Data.Text hiding (head, map, foldl1', foldl', concat)
import Nix.Expr
import Nix.Parser.Library
import Nix.Parser.Operators
import Nix.Expr
import Nix.StringOperations
import Prelude hiding (elem)
--------------------------------------------------------------------------------

29
Nix/Parser/Library.hs
View File

@ -7,22 +7,19 @@ module Nix.Parser.Library
, Trifecta.Delta(..)
) where
import Prelude
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Data.Text hiding (map)
import Text.Parser.Expression as X
import Text.Parser.LookAhead as X
import Text.Parser.Token as X
import Text.Parser.Char as X hiding (text)
import Text.Parser.Combinators as X
import Text.PrettyPrint.ANSI.Leijen as X (Doc, text)
import Text.Parser.Token.Highlight
import Text.Parser.Token.Style
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.HashSet as HashSet
import Data.Text hiding (map)
import Text.Parser.Char as X hiding (text)
import Text.Parser.Combinators as X
import Text.Parser.Expression as X
import Text.Parser.LookAhead as X
import Text.Parser.Token as X
import Text.Parser.Token.Highlight
import Text.Parser.Token.Style
import Text.PrettyPrint.ANSI.Leijen as X (Doc, text)
#if USE_PARSEC
import qualified Text.Parsec as Parsec
import qualified Text.Parsec.Text as Parsec
@ -31,7 +28,7 @@ import qualified Data.Text.IO as T
import qualified Text.Trifecta as Trifecta
import qualified Text.Trifecta.Delta as Trifecta
import Text.Trifecta as X (Result(..))
import Text.Trifecta as X (Result(..))
#endif
newtype NixParser p a = NixParser { runNixParser :: p a }

3
Nix/Parser/Operators.hs
View File

@ -5,11 +5,8 @@ import Data.Foldable (concat)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Data.Typeable (Typeable)
import GHC.Exts
import GHC.Generics
import Nix.Expr
import Prelude hiding (readFile, concat, concatMap, elem, mapM,
sequence, minimum, foldr)
data NSpecialOp = NHasAttrOp | NSelectOp | NAppOp
deriving (Eq, Ord, Generic, Typeable, Data, Show)

29
Nix/Pretty.hs
View File

@ -1,22 +1,21 @@
{-# LANGUAGE OverloadedStrings #-}
module Nix.Pretty where
import Prelude hiding ((<$>))
import Data.Fix
import Data.Map (toList)
import Data.Maybe (isJust)
import Data.Text (pack, unpack, replace, strip)
import Data.List (isPrefixOf, intercalate)
import Nix.Atoms
import Nix.Eval (NValue, NValueF (..), atomText)
import Nix.Expr
import Nix.Parser.Library (reservedNames)
import Nix.Parser.Operators
import Nix.StringOperations
import Text.PrettyPrint.ANSI.Leijen
import qualified Data.Text as Text
import Data.Fix
import qualified Data.HashSet as HashSet
import Data.List (isPrefixOf, intercalate)
import Data.Map (toList)
import Data.Maybe (isJust)
import Data.Text (pack, unpack, replace, strip)
import qualified Data.Text as Text
import Nix.Atoms
import Nix.Eval (NValue, NValueF (..), atomText)
import Nix.Expr
import Nix.Parser.Library (reservedNames)
import Nix.Parser.Operators
import Nix.StringOperations
import Prelude hiding ((<$>))
import Text.PrettyPrint.ANSI.Leijen
-- | This type represents a pretty printed nix expression
-- together with some information about the expression.

4
Nix/StringOperations.hs
View File

@ -1,14 +1,12 @@
-- | Functions for manipulating nix strings.
module Nix.StringOperations where
import Nix.Expr
import Data.List (intercalate)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Prelude hiding (elem)
import Data.Tuple (swap)
import Nix.Expr
-- | Merge adjacent 'Plain' values with 'mappend'.
mergePlain :: Monoid v => [Antiquoted v r] -> [Antiquoted v r]

5
default.nix
View File

@ -2,7 +2,7 @@
, data-fix, deepseq, deriving-compat, directory, filepath, Glob
, parsers, regex-tdfa, regex-tdfa-text, semigroups, split, stdenv
, tasty, tasty-hunit, tasty-th, text, transformers, trifecta
, unordered-containers, these
, unordered-containers, these, optparse-applicative
}:
mkDerivation {
pname = "hnix";
@ -16,7 +16,8 @@ mkDerivation {
trifecta unordered-containers these
];
executableHaskellDepends = [
ansi-wl-pprint base containers data-fix deepseq
ansi-wl-pprint base containers data-fix deepseq optparse-applicative
text
];
testHaskellDepends = [
base containers data-fix directory filepath Glob split tasty

3
hnix.cabal
View File

@ -46,7 +46,6 @@ Library
KindSignatures
LambdaCase
MultiWayIf
NoImplicitPrelude
OverloadedStrings
PatternGuards
RankNTypes
@ -99,6 +98,8 @@ Executable hnix
, ansi-wl-pprint
, data-fix
, deepseq
, optparse-applicative
, text
Ghc-options: -Wall -threaded
Test-suite hnix-tests

87
main/Main.hs
View File

@ -1,38 +1,63 @@
{-# LANGUAGE LambdaCase #-}
module Main where
import Nix.Parser
import Nix.Pretty
import Nix.Expr
import qualified Data.Map.Lazy as Map
import Nix.Eval
import Nix.Parser
import Nix.Pretty
import Options.Applicative hiding (ParserResult(..))
import System.IO
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
import System.Environment
import System.IO
import Text.PrettyPrint.ANSI.Leijen
data Options = Options
{ verbose :: Bool
, debug :: Bool
, evaluate :: Bool
, filePath :: Maybe FilePath
, expression :: Maybe String
}
nix :: FilePath -> IO ()
nix path = parseNixFile path >>= displayNExpr
nixString :: String -> IO ()
nixString = displayNExpr . parseNixString
displayNExpr :: Result NExpr -> IO ()
displayNExpr = \case
Success n -> displayIO stdout $ renderPretty 0.4 80 (prettyNix n)
Failure e -> hPutStrLn stderr $ "Parse failed: " ++ show e
mainOptions :: Parser Options
mainOptions = Options
<$> switch
( short 'v'
<> long "verbose"
<> help "Verbose output")
<*> switch
( short 'd'
<> long "debug"
<> help "Debug output")
<*> switch
( long "eval"
<> help "Whether to evaluate, or just pretty-print")
<*> optional (strOption
( short 'f'
<> long "file"
<> help "File to parse or evaluate"))
<*> optional (strOption
( short 'e'
<> long "expr"
<> help "Expression to parse or evaluate"))
main :: IO ()
main = do
let usageStr = "Parses a nix file and prints to stdout.\n\
\\n\
\Usage:\n\
\ hnix --help\n\
\ hnix <path>\n\
\ hnix --expr <expr>\n"
let argErr msg = error $ "Invalid arguments: " ++ msg ++ "\n" ++ usageStr
getArgs >>= \case
"--help":_ -> putStrLn usageStr
"--expr":expr:_ -> nixString expr
"--expr":_ -> argErr "Provide an expression."
('-':_):_ -> argErr "Provide a path to a nix file."
path:_ -> nix path
_ -> argErr "Provide a path to a nix file."
opts <- execParser optsDef
eres <- case expression opts of
Just s -> return $ parseNixString s
Nothing -> case filePath opts of
Just "-" -> parseNixString <$> getContents
Nothing -> parseNixString <$> getContents
Just path -> parseNixFile path
case eres of
Failure err -> hPutStrLn stderr $ "Parse failed: " ++ show err
Success expr ->
if evaluate opts
then if debug opts
then print =<< tracingExprEval expr <*> pure Map.empty
else print $ evalExpr expr Map.empty
else displayIO stdout $ renderPretty 0.4 80 (prettyNix expr)
where
optsDef :: ParserInfo Options
optsDef = info (helper <*> mainOptions)
(fullDesc <> progDesc "" <> header "hnix")

12
tests/EvalTests.hs
View File

@ -3,18 +3,14 @@
module EvalTests (tests) where
import Data.Fix
import Data.Monoid (Monoid(..))
import Nix.Eval
import Nix.Expr
import Nix.Parser
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.TH
import Nix.Eval
import Nix.Parser
import Nix.Expr
import Data.Monoid (Monoid(..))
import Prelude (String)
case_basic_sum :: Assertion
case_basic_sum = constantEqualStr "2" "1 + 1"

9
tests/Main.hs
View File

@ -1,13 +1,10 @@
module Main where
import Test.Tasty
import qualified ParserTests
import qualified EvalTests
import qualified PrettyTests
import qualified NixLanguageTests
import Prelude (IO, ($))
import qualified ParserTests
import qualified PrettyTests
import Test.Tasty
main :: IO ()
main = do

53
tests/NixLanguageTests.hs
View File

@ -3,36 +3,29 @@
module NixLanguageTests (genTests) where
import Data.Fix
import Data.Text.IO (readFile)
import qualified Data.Text as Text
import Control.Arrow ((&&&))
import Control.Exception
import Control.Monad (filterM)
import Data.Fix
import Data.Functor.Identity
import Data.List (delete, intercalate, sort)
import Data.List.Split (splitOn)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.List (delete, intercalate, sort)
import Data.List.Split (splitOn)
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.TH
import Nix.Eval
import Nix.Builtins
import Nix.Expr
import Nix.Parser
import Nix.Pretty
import System.Directory (listDirectory, doesFileExist)
import System.FilePath.Glob (compile, globDir1)
import System.FilePath.Posix
import Control.Monad (filterM)
import Control.Exception
import Control.Arrow ((&&&))
import Data.Functor.Identity
import GHC.Exts
import Prelude hiding (readFile)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import GHC.Exts
import Nix.Builtins
import Nix.Eval
import Nix.Expr
import Nix.Parser
import Nix.Pretty
import System.Directory (listDirectory, doesFileExist)
import System.FilePath.Glob (compile, globDir1)
import System.FilePath.Posix
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.TH
{-
From (git://nix)/tests/lang.sh we see that
@ -88,7 +81,7 @@ assertParseFail file = parseNixFile file >>= (\x -> case x of
assertLangOk :: FilePath -> Assertion
assertLangOk file = do
actual <- printNix <$> nixEvalFile (file ++ ".nix")
expected <- readFile $ file ++ ".exp"
expected <- Text.readFile $ file ++ ".exp"
seq actual $ seq expected $
assertEqual "" expected $ Text.pack (actual ++ "\n")

22
tests/ParserTests.hs
View File

@ -2,20 +2,16 @@
{-# LANGUAGE OverloadedStrings #-}
module ParserTests (tests) where
import Data.Fix
import Data.Text (pack)
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.TH
import Data.Fix
import qualified Data.Map as Map
import Nix.Atoms
import Nix.Expr
import Nix.Parser
import Nix.StringOperations
import Prelude
import Data.Text (pack)
import Nix.Atoms
import Nix.Expr
import Nix.Parser
import Nix.StringOperations
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.TH
case_constant_int :: Assertion
case_constant_int = assertParseString "234" $ mkInt 234