Merge remote-tracking branch 'origin/pending' into remove-fromnix-text-instances
This commit is contained in:
Doug Beardsley
commit
a39a5518ea
|
|
@ -15,8 +15,8 @@ env:
|
|||
- secure: "dm6I+M4+V+C7QMTpcSADdKPE633SvmToXZrTbZ7miNDGmMN+/SfHeN2ybi1+PW6oViMlbPN/7J/aEfiGjSJI8vLk72Y4uCWGmpSb8TXZLu6+whnxtZzzW8+z4tsM4048QJg7CF3N/25U8thRFgs3DqUub1Sf3nG9LrNWdz6ZcDQ="
|
||||
|
||||
matrix:
|
||||
- GHCVERSION=ghc843 STRICT=false TRACING=false
|
||||
- GHCVERSION=ghc843 STRICT=false TRACING=true
|
||||
- GHCVERSION=ghc844 STRICT=false TRACING=false
|
||||
- GHCVERSION=ghc844 STRICT=false TRACING=true
|
||||
# - GHCVERSION=ghcjs
|
||||
#
|
||||
# matrix:
|
||||
|
|
|
|||
29
default.nix
29
default.nix
|
|
@ -1,11 +1,15 @@
|
|||
{ compiler ? "ghc843"
|
||||
{ compiler ? "ghc844"
|
||||
|
||||
, doBenchmark ? false
|
||||
, doTracing ? false
|
||||
# enables GHC optimizations for production use
|
||||
, doOptimize ? false
|
||||
# enables profiling support in GHC
|
||||
, doProfiling ? false
|
||||
, doStrict ? false
|
||||
|
||||
, rev ? "7c1b85cf6de1dc431e5736bff8adf01224e6abe5"
|
||||
, sha256 ? "1i8nvc4r0zx263ch5k3b6nkg78sc9ggx2d4lzri6kmng315pcs05"
|
||||
, rev ? "b37872d4268164614e3ecef6e1f730d48cf5a90f"
|
||||
, sha256 ? "05km33sz4srf05vvmkidz3k59phm5a3k9wpj1jc6ly9yqws0dbn4"
|
||||
, pkgs ?
|
||||
if builtins.compareVersions builtins.nixVersion "2.0" < 0
|
||||
then abort "hnix requires at least nix 2.0"
|
||||
|
|
@ -28,6 +32,12 @@ drv = haskellPackages.developPackage {
|
|||
|
||||
overrides = with pkgs.haskell.lib; self: super: {
|
||||
mono-traversable = dontCheck super.mono-traversable;
|
||||
megaparsec = self.callCabal2nix "megaparsec" (pkgs.fetchFromGitHub {
|
||||
owner = "mrkkrp";
|
||||
repo = "megaparsec";
|
||||
rev = "9fff501f7794c01e2cf4a7a492f1cfef67fab19a";
|
||||
sha256 = "0a9g6gpc8m9qrvldwn4chs0yqnr4dps93achg1df72lxknrpp0iy";
|
||||
}) {};
|
||||
}
|
||||
//
|
||||
(if compiler == "ghc802"
|
||||
|
|
@ -70,24 +80,19 @@ drv = haskellPackages.developPackage {
|
|||
pkgs.haskell.packages.${compiler}.cabal-install
|
||||
];
|
||||
|
||||
enableLibraryProfiling = false;
|
||||
enableLibraryProfiling = doProfiling;
|
||||
enableExecutableProfiling = doProfiling;
|
||||
|
||||
testHaskellDepends = attrs.testHaskellDepends ++
|
||||
[ pkgs.nix
|
||||
|
||||
# Use the same version of hpack no matter what the compiler version
|
||||
# is, so that we know exactly what the contents of the generated
|
||||
# .cabal file will be. Otherwise, Travis may error out claiming that
|
||||
# the cabal file needs to be updated because the result is different
|
||||
# that the version we committed to Git.
|
||||
pkgs.haskell.packages.ghc843.hpack
|
||||
pkgs.haskell.packages.ghc843.criterion
|
||||
pkgs.haskell.packages.ghc844.criterion
|
||||
];
|
||||
|
||||
inherit doBenchmark;
|
||||
|
||||
configureFlags =
|
||||
pkgs.stdenv.lib.optional doTracing "--flags=tracing"
|
||||
++ pkgs.stdenv.lib.optional doOptimize "--flags=optimize"
|
||||
++ pkgs.stdenv.lib.optional doStrict "--ghc-options=-Werror";
|
||||
|
||||
passthru = {
|
||||
|
|
|
|||
22
hnix.cabal
22
hnix.cabal
|
|
@ -1,10 +1,3 @@
|
|||
-- This file has been generated from package.yaml by hpack version 0.28.2.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: d6ddd115698a11c74ef8507fa6e00df1f8888a254bed435e6a75b154a4906cb3
|
||||
|
||||
cabal-version: >= 1.10
|
||||
name: hnix
|
||||
version: 0.5.2
|
||||
synopsis: Haskell implementation of the Nix language
|
||||
|
|
@ -17,6 +10,7 @@ maintainer: johnw@newartisans.com
|
|||
license: BSD3
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
cabal-version: >= 1.10
|
||||
extra-source-files:
|
||||
data/let-comments-multiline.nix
|
||||
data/let-comments.nix
|
||||
|
|
@ -486,7 +480,6 @@ library
|
|||
ghc-options: -Wall
|
||||
build-depends:
|
||||
aeson
|
||||
, ansi-wl-pprint
|
||||
, array >=0.4 && <0.6
|
||||
, base >=4.9 && <5
|
||||
, binary
|
||||
|
|
@ -507,10 +500,12 @@ library
|
|||
, interpolate
|
||||
, lens-family-th
|
||||
, logict
|
||||
, megaparsec >=6.5 && <7.0
|
||||
, megaparsec >=7.0 && <7.1
|
||||
, monadlist
|
||||
, mtl
|
||||
, optparse-applicative
|
||||
, parser-combinators
|
||||
, prettyprinter
|
||||
, process
|
||||
, ref-tf
|
||||
, regex-tdfa
|
||||
|
|
@ -573,10 +568,9 @@ executable hnix
|
|||
Paths_hnix
|
||||
hs-source-dirs:
|
||||
main
|
||||
ghc-options: -Wall
|
||||
ghc-options: -Wall -rtsopts
|
||||
build-depends:
|
||||
aeson
|
||||
, ansi-wl-pprint
|
||||
, base >=4.9 && <5
|
||||
, bytestring
|
||||
, containers
|
||||
|
|
@ -590,6 +584,7 @@ executable hnix
|
|||
, mtl
|
||||
, optparse-applicative
|
||||
, pretty-show
|
||||
, prettyprinter
|
||||
, repline
|
||||
, template-haskell
|
||||
, text
|
||||
|
|
@ -635,7 +630,6 @@ test-suite hnix-tests
|
|||
build-depends:
|
||||
Diff
|
||||
, Glob
|
||||
, ansi-wl-pprint
|
||||
, base >=4.9 && <5
|
||||
, bytestring
|
||||
, containers
|
||||
|
|
@ -654,6 +648,7 @@ test-suite hnix-tests
|
|||
, mtl
|
||||
, optparse-applicative
|
||||
, pretty-show
|
||||
, prettyprinter
|
||||
, process
|
||||
, split
|
||||
, tasty
|
||||
|
|
@ -699,8 +694,7 @@ benchmark hnix-benchmarks
|
|||
benchmarks
|
||||
ghc-options: -Wall
|
||||
build-depends:
|
||||
ansi-wl-pprint
|
||||
, base >=4.9 && <5
|
||||
base >=4.9 && <5
|
||||
, bytestring
|
||||
, containers
|
||||
, criterion
|
||||
|
|
|
|||
|
|
@ -24,6 +24,8 @@ import qualified Data.Text as Text
|
|||
import qualified Data.Text.IO as Text
|
||||
import qualified Data.Text.Lazy.Encoding as TL
|
||||
import qualified Data.Text.Lazy.IO as TL
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Data.Text.Prettyprint.Doc.Render.Text
|
||||
import Nix
|
||||
import Nix.Convert
|
||||
import qualified Nix.Eval as Eval
|
||||
|
|
@ -36,7 +38,6 @@ import Options.Applicative hiding (ParserResult(..))
|
|||
import qualified Repl
|
||||
import System.FilePath
|
||||
import System.IO
|
||||
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
|
||||
import qualified Text.Show.Pretty as PS
|
||||
|
||||
main :: IO ()
|
||||
|
|
@ -127,8 +128,8 @@ main = do
|
|||
void $ liftIO $ Exc.evaluate $ Deep.force expr
|
||||
|
||||
| otherwise =
|
||||
liftIO $ displayIO stdout
|
||||
. renderPretty 0.4 80
|
||||
liftIO $ renderIO stdout
|
||||
. layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)
|
||||
. prettyNix
|
||||
. stripAnnotation $ expr
|
||||
where
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiWayIf #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
|
@ -180,7 +181,13 @@ completer = Prefix (wordCompleter comp) defaultMatcher
|
|||
|
||||
shell :: (MonadNix e m, MonadIO m, MonadException m) => Repl e m a -> m ()
|
||||
shell pre = flip evalStateT initState $
|
||||
evalRepl "hnix> " cmd options completer pre
|
||||
#if MIN_VERSION_repline(0, 2, 0)
|
||||
evalRepl (return prefix() cmd options Nothing completer pre
|
||||
#else
|
||||
evalRepl prefix cmd options completer pre
|
||||
#endif
|
||||
where
|
||||
prefix = "hnix> "
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Toplevel
|
||||
|
|
|
|||
218
package.yaml
218
package.yaml
|
|
@ -1,218 +0,0 @@
|
|||
name: hnix
|
||||
version: 0.5.2
|
||||
synopsis: Haskell implementation of the Nix language
|
||||
github: haskell-nix/hnix
|
||||
author: John Wiegley
|
||||
maintainer: johnw@newartisans.com
|
||||
category: System, Data, Nix
|
||||
license: BSD3
|
||||
|
||||
description:
|
||||
Haskell implementation of the Nix language.
|
||||
|
||||
extra-source-files:
|
||||
- LICENSE
|
||||
- README.md
|
||||
- package.yaml
|
||||
- data/*
|
||||
- data/nix/*
|
||||
- data/nix/corepkgs/*
|
||||
- data/nix/config/*
|
||||
- data/nix/perl/*
|
||||
- data/nix/perl/lib/Nix/*
|
||||
- data/nix/tests/*
|
||||
- data/nix/tests/plugins/*
|
||||
- data/nix/tests/lang/*
|
||||
- data/nix/tests/lang/readDir/*
|
||||
- data/nix/tests/lang/readDir/foo/*
|
||||
- data/nix/tests/lang/dir2/*
|
||||
- data/nix/tests/lang/dir4/*
|
||||
- data/nix/tests/lang/dir3/*
|
||||
- data/nix/tests/lang/dir1/*
|
||||
- data/nix/maintainers/*
|
||||
- data/nix/mk/*
|
||||
- data/nix/scripts/*
|
||||
- tests/eval-compare/*
|
||||
|
||||
flags:
|
||||
tracing:
|
||||
description: Enable full debug tracing
|
||||
manual: True
|
||||
default: False
|
||||
|
||||
profiling:
|
||||
description: Enable profiling
|
||||
manual: True
|
||||
default: False
|
||||
|
||||
optimize:
|
||||
description: Enable all optimization flags
|
||||
manual: True
|
||||
default: False
|
||||
|
||||
ghc-options:
|
||||
- -Wall
|
||||
|
||||
dependencies:
|
||||
- base >= 4.9 && < 5
|
||||
- ansi-wl-pprint
|
||||
- bytestring
|
||||
- containers
|
||||
- data-fix
|
||||
- deepseq >= 1.4.2 && < 1.5
|
||||
- exceptions
|
||||
- filepath
|
||||
- hashing
|
||||
- mtl
|
||||
- optparse-applicative
|
||||
- template-haskell
|
||||
- text
|
||||
- time
|
||||
- transformers
|
||||
- unordered-containers >= 0.2.9 && < 0.3
|
||||
|
||||
when:
|
||||
- condition: flag(optimize)
|
||||
ghc-options:
|
||||
- -fexpose-all-unfoldings
|
||||
- -fspecialise-aggressively
|
||||
- -O2
|
||||
|
||||
- condition: flag(tracing)
|
||||
cpp-options: -DENABLE_TRACING=1
|
||||
|
||||
- condition: "os(linux) && impl(ghc >= 8.2) && impl(ghc < 8.3)"
|
||||
dependencies:
|
||||
- compact
|
||||
|
||||
- condition: "!impl(ghcjs)"
|
||||
dependencies:
|
||||
- base16-bytestring
|
||||
- cryptohash-md5
|
||||
- cryptohash-sha1
|
||||
- cryptohash-sha256
|
||||
- cryptohash-sha512
|
||||
- serialise
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
dependencies:
|
||||
- aeson
|
||||
- ansi-wl-pprint
|
||||
- array >= 0.4 && < 0.6
|
||||
- binary
|
||||
- deriving-compat >= 0.3 && < 0.6
|
||||
- dependent-sum
|
||||
- directory
|
||||
- free
|
||||
- http-types
|
||||
- http-client
|
||||
- http-client-tls
|
||||
- interpolate
|
||||
- lens-family-th
|
||||
- logict
|
||||
- megaparsec >= 6.5 && < 7.0
|
||||
- monadlist
|
||||
- process
|
||||
- regex-tdfa
|
||||
- regex-tdfa-text
|
||||
- ref-tf
|
||||
- scientific
|
||||
- semigroups >= 0.18 && < 0.19
|
||||
- split
|
||||
- syb
|
||||
- these
|
||||
- unix
|
||||
- vector
|
||||
- xml
|
||||
when:
|
||||
- condition: "impl(ghc < 8.1)"
|
||||
then:
|
||||
dependencies:
|
||||
- lens-family == 1.2.1
|
||||
- lens-family-core == 1.2.1
|
||||
else:
|
||||
dependencies:
|
||||
- lens-family >= 1.2.2
|
||||
- lens-family-core >= 1.2.2
|
||||
|
||||
- condition: "impl(ghc < 8.4.0) && !flag(profiling)"
|
||||
dependencies:
|
||||
- ghc-datasize
|
||||
|
||||
- condition: "impl(ghcjs)"
|
||||
then:
|
||||
dependencies:
|
||||
- hashable >= 1.2.4 && < 1.3
|
||||
else:
|
||||
exposed-modules:
|
||||
- Nix.Options.Parser
|
||||
dependencies:
|
||||
- hashable >= 1.2.5 && < 1.3
|
||||
- haskeline
|
||||
- pretty-show
|
||||
|
||||
executables:
|
||||
hnix:
|
||||
source-dirs: main
|
||||
main: Main.hs
|
||||
dependencies:
|
||||
- hnix
|
||||
- aeson
|
||||
- pretty-show
|
||||
- repline
|
||||
- haskeline
|
||||
when:
|
||||
- condition: "impl(ghcjs)"
|
||||
then:
|
||||
buildable: false
|
||||
else:
|
||||
buildable: true
|
||||
|
||||
tests:
|
||||
hnix-tests:
|
||||
source-dirs: tests
|
||||
main: Main.hs
|
||||
ghc-options: -threaded
|
||||
verbatim:
|
||||
build-tool-depends:
|
||||
hspec-discover:hspec-discover == 2.*
|
||||
dependencies:
|
||||
- hnix
|
||||
- Glob
|
||||
- directory
|
||||
- interpolate
|
||||
- process
|
||||
- split
|
||||
- tasty
|
||||
- tasty-hedgehog
|
||||
- tasty-hunit
|
||||
- tasty-th
|
||||
- unix
|
||||
- hedgehog
|
||||
- generic-random
|
||||
- Diff
|
||||
- megaparsec
|
||||
- tasty-quickcheck
|
||||
- pretty-show
|
||||
- dependent-sum
|
||||
when:
|
||||
- condition: "impl(ghcjs)"
|
||||
then:
|
||||
buildable: false
|
||||
else:
|
||||
buildable: true
|
||||
|
||||
benchmarks:
|
||||
hnix-benchmarks:
|
||||
source-dirs: benchmarks
|
||||
main: Main.hs
|
||||
dependencies:
|
||||
- hnix
|
||||
- criterion
|
||||
when:
|
||||
- condition: "impl(ghcjs)"
|
||||
then:
|
||||
buildable: false
|
||||
else:
|
||||
buildable: true
|
||||
|
|
@ -60,7 +60,6 @@ import qualified Data.HashMap.Lazy as M
|
|||
import qualified Data.HashSet as HS
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Semigroup
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as S
|
||||
import Data.String.Interpolate.IsString
|
||||
|
|
|
|||
|
|
@ -205,8 +205,12 @@ desugarBinds embed binds = evalState (mapM (go <=< collect) binds) M.empty
|
|||
(Binding r)
|
||||
go (Right x) = pure x
|
||||
go (Left x) = do
|
||||
Just (p, v) <- gets $ M.lookup x
|
||||
pure $ NamedVar (StaticKey x :| []) (embed v) p
|
||||
maybeValue <- gets (M.lookup x)
|
||||
case maybeValue of
|
||||
Nothing ->
|
||||
fail ("No binding " ++ show x)
|
||||
Just (p, v) ->
|
||||
pure $ NamedVar (StaticKey x :| []) (embed v) p
|
||||
|
||||
evalBinds :: forall v t m. MonadNixEval v t m
|
||||
=> Bool
|
||||
|
|
|
|||
|
|
@ -46,9 +46,9 @@ import Data.List
|
|||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.List.Split
|
||||
import Data.Maybe (maybeToList)
|
||||
import Data.Monoid
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Data.Typeable
|
||||
import Nix.Atoms
|
||||
import Nix.Context
|
||||
|
|
@ -71,8 +71,6 @@ import Nix.Value
|
|||
import System.Console.Haskeline.MonadException hiding (catch)
|
||||
#endif
|
||||
import System.FilePath
|
||||
import Text.PrettyPrint.ANSI.Leijen (text)
|
||||
import qualified Text.PrettyPrint.ANSI.Leijen as P
|
||||
#ifdef MIN_VERSION_pretty_show
|
||||
import qualified Text.Show.Pretty as PS
|
||||
#endif
|
||||
|
|
@ -574,8 +572,10 @@ instance (MonadFix m, MonadCatch m, MonadFile m, MonadStore m, MonadVar m,
|
|||
eres <- parseNixFileLoc path
|
||||
case eres of
|
||||
Failure err ->
|
||||
throwError $ ErrorCall . show $
|
||||
text "Parse during import failed:" P.</> err
|
||||
throwError $ ErrorCall . show $ fillSep $
|
||||
[ "Parse during import failed:"
|
||||
, err
|
||||
]
|
||||
Success expr -> do
|
||||
Lazy $ ReaderT $ const $
|
||||
modify (M.insert path expr)
|
||||
|
|
@ -726,16 +726,16 @@ addTracing k v = do
|
|||
let rendered =
|
||||
if verbose opts >= Chatty
|
||||
#ifdef MIN_VERSION_pretty_show
|
||||
then text $ PS.ppShow (void x)
|
||||
then pretty $ PS.ppShow (void x)
|
||||
#else
|
||||
then text $ show (void x)
|
||||
then pretty $ show (void x)
|
||||
#endif
|
||||
else prettyNix (Fix (Fix (NSym "?") <$ x))
|
||||
msg x = text ("eval: " ++ replicate depth ' ') <> x
|
||||
loc <- renderLocation span (msg rendered <> text " ...\n")
|
||||
msg x = pretty ("eval: " ++ replicate depth ' ') <> x
|
||||
loc <- renderLocation span (msg rendered <> " ...\n")
|
||||
putStr $ show loc
|
||||
res <- k v'
|
||||
print $ msg rendered <> text " ...done"
|
||||
print $ msg rendered <> " ...done"
|
||||
return res
|
||||
|
||||
evalExprLoc :: forall e m. (MonadNix e m, Has e Options)
|
||||
|
|
|
|||
|
|
@ -9,7 +9,6 @@ module Nix.Expr.Shorthands where
|
|||
|
||||
import Data.Fix
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Monoid
|
||||
import Data.Text (Text)
|
||||
import Nix.Atoms
|
||||
import Nix.Expr.Types
|
||||
|
|
|
|||
|
|
@ -50,7 +50,6 @@ import Data.List (inits, tails)
|
|||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Monoid
|
||||
import Data.Ord.Deriving
|
||||
import Data.Text (Text, pack, unpack)
|
||||
import Data.Traversable
|
||||
|
|
|
|||
|
|
@ -38,7 +38,6 @@ import Data.Hashable
|
|||
import Data.Hashable.Lifted
|
||||
#endif
|
||||
import Data.Ord.Deriving
|
||||
import Data.Semigroup
|
||||
import Data.Text (Text, pack)
|
||||
import GHC.Generics
|
||||
import Nix.Atoms
|
||||
|
|
|
|||
|
|
@ -372,7 +372,7 @@ lintApp context fun arg = unpackSymbolic fun >>= \case
|
|||
NAny -> throwError $ ErrorCall
|
||||
"Cannot apply something not known to be a function"
|
||||
NMany xs -> do
|
||||
(args:_, ys) <- fmap unzip $ forM xs $ \case
|
||||
(args, ys) <- fmap unzip $ forM xs $ \case
|
||||
TClosure _params -> arg >>= unpackSymbolic >>= \case
|
||||
NAny -> do
|
||||
error "NYI"
|
||||
|
|
@ -386,7 +386,7 @@ lintApp context fun arg = unpackSymbolic fun >>= \case
|
|||
_x -> throwError $ ErrorCall "Attempt to call non-function"
|
||||
|
||||
y <- everyPossible
|
||||
(args,) <$> foldM (unify context) y ys
|
||||
(head args,) <$> foldM (unify context) y ys
|
||||
|
||||
newtype Lint s a = Lint
|
||||
{ runLint :: ReaderT (Context (Lint s) (SThunk (Lint s))) (ST s) a }
|
||||
|
|
|
|||
|
|
@ -19,13 +19,8 @@ import Control.Monad.Trans.State
|
|||
import qualified Data.HashMap.Lazy as M
|
||||
import Data.List (find)
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Nix.Atoms
|
||||
import Nix.Effects
|
||||
import Nix.Frames
|
||||
-- import Nix.Pretty
|
||||
import Nix.String
|
||||
import Nix.Thunk
|
||||
import Nix.Utils
|
||||
import Nix.Value
|
||||
|
|
|
|||
|
|
@ -8,7 +8,6 @@ import qualified Data.Text as Text
|
|||
import Data.Time
|
||||
import Nix.Options
|
||||
import Options.Applicative hiding (ParserResult(..))
|
||||
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
|
||||
|
||||
decodeVerbosity :: Int -> Verbosity
|
||||
decodeVerbosity 0 = ErrorsOnly
|
||||
|
|
|
|||
|
|
@ -51,6 +51,7 @@ import Prelude hiding (readFile)
|
|||
import Control.Applicative hiding (many, some)
|
||||
import Control.DeepSeq
|
||||
import Control.Monad
|
||||
import Control.Monad.Combinators.Expr
|
||||
import Data.Char (isAlpha, isDigit, isSpace)
|
||||
import Data.Data (Data(..))
|
||||
import Data.Foldable (concat)
|
||||
|
|
@ -63,6 +64,7 @@ import qualified Data.List.NonEmpty as NE
|
|||
import qualified Data.Map as Map
|
||||
import Data.Text (Text)
|
||||
import Data.Text hiding (map, foldr1, concat, concatMap, zipWith)
|
||||
import Data.Text.Prettyprint.Doc (Doc, pretty)
|
||||
import Data.Text.Encoding
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Void
|
||||
|
|
@ -73,8 +75,6 @@ import Nix.Strings
|
|||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
import qualified Text.Megaparsec.Char.Lexer as L
|
||||
import Text.Megaparsec.Expr
|
||||
import Text.PrettyPrint.ANSI.Leijen (Doc, text)
|
||||
|
||||
infixl 3 <+>
|
||||
(<+>) :: MonadPlus m => m a -> m a -> m a
|
||||
|
|
@ -284,9 +284,9 @@ nixString' = lexeme (doubleQuoted <+> indented <?> "string")
|
|||
<+> Plain . pack <$> some plainChar
|
||||
where
|
||||
plainChar =
|
||||
notFollowedBy (end <+> void (char '$') <+> escStart) *> anyChar
|
||||
notFollowedBy (end <+> void (char '$') <+> escStart) *> anySingle
|
||||
|
||||
escapeCode = msum [ c <$ char e | (c,e) <- escapeCodes ] <+> anyChar
|
||||
escapeCode = msum [ c <$ char e | (c,e) <- escapeCodes ] <+> anySingle
|
||||
|
||||
-- | Gets all of the arguments for a function.
|
||||
argExpr :: Parser (Params NExprLoc)
|
||||
|
|
@ -338,11 +338,11 @@ nixBinders = (inherit <+> namedVar) `endBy` semi where
|
|||
-- We can't use 'reserved' here because it would consume the whitespace
|
||||
-- after the keyword, which is not exactly the semantics of C++ Nix.
|
||||
try $ string "inherit" *> lookAhead (void (satisfy reservedEnd))
|
||||
p <- getPosition
|
||||
p <- getSourcePos
|
||||
x <- whiteSpace *> optional scope
|
||||
Inherit x <$> many keyName <*> pure p <?> "inherited binding"
|
||||
namedVar = do
|
||||
p <- getPosition
|
||||
p <- getSourcePos
|
||||
NamedVar <$> (annotated <$> nixSelector)
|
||||
<*> (equals *> nixToplevelForm)
|
||||
<*> pure p
|
||||
|
|
@ -439,17 +439,17 @@ reservedNames = HashSet.fromList
|
|||
|
||||
type Parser = ParsecT Void Text Identity
|
||||
|
||||
data Result a = Success a | Failure Doc deriving (Show, Functor)
|
||||
data Result a = Success a | Failure (Doc Void) deriving (Show, Functor)
|
||||
|
||||
parseFromFileEx :: MonadFile m => Parser a -> FilePath -> m (Result a)
|
||||
parseFromFileEx p path = do
|
||||
txt <- decodeUtf8 <$> readFile path
|
||||
return $ either (Failure . text . parseErrorPretty' txt) Success
|
||||
return $ either (Failure . pretty . errorBundlePretty) Success
|
||||
$ parse p path txt
|
||||
|
||||
parseFromText :: Parser a -> Text -> Result a
|
||||
parseFromText p txt =
|
||||
either (Failure . text . parseErrorPretty' txt) Success $
|
||||
either (Failure . pretty . errorBundlePretty) Success $
|
||||
parse p "<string>" txt
|
||||
|
||||
{- Parser.Operators -}
|
||||
|
|
@ -468,9 +468,9 @@ data NOperatorDef
|
|||
|
||||
annotateLocation :: Parser a -> Parser (Ann SrcSpan a)
|
||||
annotateLocation p = do
|
||||
begin <- getPosition
|
||||
begin <- getSourcePos
|
||||
res <- p
|
||||
end <- getPosition
|
||||
end <- getSourcePos
|
||||
pure $ Ann (SrcSpan begin end) res
|
||||
|
||||
annotateLocation1 :: Parser (NExprF NExprLoc) -> Parser NExprLoc
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@ import qualified Data.List.NonEmpty as NE
|
|||
import Data.Maybe (isJust, fromMaybe)
|
||||
import Data.Text (pack, unpack, replace, strip)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Nix.Atoms
|
||||
import Nix.Expr
|
||||
import Nix.Parser
|
||||
|
|
@ -38,13 +39,12 @@ import Nix.Utils hiding ((<$>))
|
|||
#endif
|
||||
import Nix.Value
|
||||
import Prelude hiding ((<$>))
|
||||
import Text.PrettyPrint.ANSI.Leijen
|
||||
|
||||
-- | This type represents a pretty printed nix expression
|
||||
-- together with some information about the expression.
|
||||
data NixDoc = NixDoc
|
||||
data NixDoc ann = NixDoc
|
||||
{ -- | The rendered expression, without any parentheses.
|
||||
withoutParens :: Doc
|
||||
withoutParens :: Doc ann
|
||||
|
||||
-- | The root operator is the operator at the root of
|
||||
-- the expression tree. For example, in '(a * b) + c', '+' would be the root
|
||||
|
|
@ -55,16 +55,16 @@ data NixDoc = NixDoc
|
|||
-- we can add brackets appropiately
|
||||
}
|
||||
|
||||
mkNixDoc :: Doc -> OperatorInfo -> NixDoc
|
||||
mkNixDoc :: Doc ann -> OperatorInfo -> NixDoc ann
|
||||
mkNixDoc d o = NixDoc { withoutParens = d, rootOp = o, wasPath = False }
|
||||
|
||||
-- | A simple expression is never wrapped in parentheses. The expression
|
||||
-- behaves as if its root operator had a precedence higher than all
|
||||
-- other operators (including function application).
|
||||
simpleExpr :: Doc -> NixDoc
|
||||
simpleExpr :: Doc ann -> NixDoc ann
|
||||
simpleExpr d = mkNixDoc d (OperatorInfo minBound NAssocNone "simple expr")
|
||||
|
||||
pathExpr :: Doc -> NixDoc
|
||||
pathExpr :: Doc ann -> NixDoc ann
|
||||
pathExpr d = (simpleExpr d) { wasPath = True }
|
||||
|
||||
-- | An expression that behaves as if its root operator had a precedence lower
|
||||
|
|
@ -72,7 +72,7 @@ pathExpr d = (simpleExpr d) { wasPath = True }
|
|||
-- parantheses in almost always, but it's still rendered without parentheses
|
||||
-- in cases where parentheses are never required (such as in the LHS of a
|
||||
-- binding).
|
||||
leastPrecedence :: Doc -> NixDoc
|
||||
leastPrecedence :: Doc ann -> NixDoc ann
|
||||
leastPrecedence =
|
||||
flip mkNixDoc $ OperatorInfo maxBound NAssocNone "least precedence"
|
||||
|
||||
|
|
@ -88,7 +88,7 @@ selectOp = getSpecialOperator NSelectOp
|
|||
hasAttrOp :: OperatorInfo
|
||||
hasAttrOp = getSpecialOperator NHasAttrOp
|
||||
|
||||
wrapParens :: OperatorInfo -> NixDoc -> Doc
|
||||
wrapParens :: OperatorInfo -> NixDoc ann -> Doc ann
|
||||
wrapParens op sub
|
||||
| precedence (rootOp sub) < precedence op = withoutParens sub
|
||||
| precedence (rootOp sub) == precedence op
|
||||
|
|
@ -98,104 +98,117 @@ wrapParens op sub
|
|||
|
||||
-- Used in the selector case to print a path in a selector as
|
||||
-- "${./abc}"
|
||||
wrapPath :: OperatorInfo -> NixDoc -> Doc
|
||||
wrapPath :: OperatorInfo -> NixDoc ann -> Doc ann
|
||||
wrapPath op sub =
|
||||
if wasPath sub then dquotes (text "$" <> braces (withoutParens sub))
|
||||
else wrapParens op sub
|
||||
if wasPath sub
|
||||
then dquotes $ "$" <> braces (withoutParens sub)
|
||||
else wrapParens op sub
|
||||
|
||||
prettyString :: NString NixDoc -> Doc
|
||||
prettyString :: NString (NixDoc ann)-> Doc ann
|
||||
prettyString (DoubleQuoted parts) = dquotes . hcat . map prettyPart $ parts
|
||||
where prettyPart (Plain t) = text . concatMap escape . unpack $ t
|
||||
prettyPart EscapedNewline = text "''\\n"
|
||||
prettyPart (Antiquoted r) = text "$" <> braces (withoutParens r)
|
||||
where prettyPart (Plain t) = pretty . concatMap escape . unpack $ t
|
||||
prettyPart EscapedNewline = "''\\n"
|
||||
prettyPart (Antiquoted r) = "$" <> braces (withoutParens r)
|
||||
escape '"' = "\\\""
|
||||
escape x = maybe [x] (('\\':) . (:[])) $ toEscapeCode x
|
||||
prettyString (Indented _ parts)
|
||||
= group $ nest 2 (squote <> squote <$$> content) <$$> squote <> squote
|
||||
= group $ nest 2 $ vcat [dsquote, content, dsquote]
|
||||
where
|
||||
dsquote = squote <> squote
|
||||
content = vsep . map prettyLine . stripLastIfEmpty . splitLines $ parts
|
||||
stripLastIfEmpty = reverse . f . reverse where
|
||||
f ([Plain t] : xs) | Text.null (strip t) = xs
|
||||
f xs = xs
|
||||
prettyLine = hcat . map prettyPart
|
||||
prettyPart (Plain t) = text . unpack . replace "${" "''${" . replace "''" "'''" $ t
|
||||
prettyPart EscapedNewline = text "\\n"
|
||||
prettyPart (Antiquoted r) = text "$" <> braces (withoutParens r)
|
||||
prettyPart (Plain t) = pretty . unpack . replace "${" "''${" . replace "''" "'''" $ t
|
||||
prettyPart EscapedNewline = "\\n"
|
||||
prettyPart (Antiquoted r) = "$" <> braces (withoutParens r)
|
||||
|
||||
prettyParams :: Params NixDoc -> Doc
|
||||
prettyParams (Param n) = text $ unpack n
|
||||
prettyParams :: Params (NixDoc ann) -> Doc ann
|
||||
prettyParams (Param n) = pretty $ unpack n
|
||||
prettyParams (ParamSet s v mname) = prettyParamSet s v <> case mname of
|
||||
Nothing -> empty
|
||||
Just name | Text.null name -> empty
|
||||
| otherwise -> text "@" <> text (unpack name)
|
||||
Nothing -> mempty
|
||||
Just name | Text.null name -> mempty
|
||||
| otherwise -> "@" <> pretty (unpack name)
|
||||
|
||||
prettyParamSet :: ParamSet NixDoc -> Bool -> Doc
|
||||
prettyParamSet :: ParamSet (NixDoc ann) -> Bool -> Doc ann
|
||||
prettyParamSet args var =
|
||||
encloseSep (lbrace <> space) (align (space <> rbrace)) sep (map prettySetArg args ++ prettyVariadic)
|
||||
where
|
||||
prettySetArg (n, maybeDef) = case maybeDef of
|
||||
Nothing -> text (unpack n)
|
||||
Just v -> text (unpack n) <+> text "?" <+> withoutParens v
|
||||
prettyVariadic = [text "..." | var]
|
||||
Nothing -> pretty (unpack n)
|
||||
Just v -> pretty (unpack n) <+> "?" <+> withoutParens v
|
||||
prettyVariadic = ["..." | var]
|
||||
sep = align (comma <> space)
|
||||
|
||||
prettyBind :: Binding NixDoc -> Doc
|
||||
prettyBind :: Binding (NixDoc ann) -> Doc ann
|
||||
prettyBind (NamedVar n v _p) =
|
||||
prettySelector n <+> equals <+> withoutParens v <> semi
|
||||
prettyBind (Inherit s ns _p)
|
||||
= text "inherit" <+> scope <> align (fillSep (map prettyKeyName ns)) <> semi
|
||||
where scope = maybe empty ((<> space) . parens . withoutParens) s
|
||||
= "inherit" <+> scope <> align (fillSep (map prettyKeyName ns)) <> semi
|
||||
where scope = maybe mempty ((<> space) . parens . withoutParens) s
|
||||
|
||||
prettyKeyName :: NKeyName NixDoc -> Doc
|
||||
prettyKeyName (StaticKey "") = dquotes $ text ""
|
||||
prettyKeyName :: NKeyName (NixDoc ann) -> Doc ann
|
||||
prettyKeyName (StaticKey "") = dquotes ""
|
||||
prettyKeyName (StaticKey key)
|
||||
| HashSet.member key reservedNames = dquotes $ text $ unpack key
|
||||
prettyKeyName (StaticKey key) = text . unpack $ key
|
||||
| HashSet.member key reservedNames = dquotes $ pretty $ unpack key
|
||||
prettyKeyName (StaticKey key) = pretty . unpack $ key
|
||||
prettyKeyName (DynamicKey key) =
|
||||
runAntiquoted (DoubleQuoted [Plain "\n"])
|
||||
prettyString ((text "$" <>) . braces . withoutParens) key
|
||||
prettyString (("$" <>) . braces . withoutParens) key
|
||||
|
||||
prettySelector :: NAttrPath NixDoc -> Doc
|
||||
prettySelector :: NAttrPath (NixDoc ann) -> Doc ann
|
||||
prettySelector = hcat . punctuate dot . map prettyKeyName . NE.toList
|
||||
|
||||
prettyAtom :: NAtom -> NixDoc
|
||||
prettyAtom atom = simpleExpr $ text $ unpack $ atomText atom
|
||||
prettyAtom :: NAtom -> NixDoc ann
|
||||
prettyAtom atom = simpleExpr $ pretty $ unpack $ atomText atom
|
||||
|
||||
prettyNix :: NExpr -> Doc
|
||||
prettyNix :: NExpr -> Doc ann
|
||||
prettyNix = withoutParens . cata exprFNixDoc
|
||||
|
||||
prettyOriginExpr :: NExprLocF (Maybe (NValue m)) -> Doc
|
||||
prettyOriginExpr :: NExprLocF (Maybe (NValue m)) -> Doc ann
|
||||
prettyOriginExpr = withoutParens . go
|
||||
where
|
||||
go = exprFNixDoc . annotated . getCompose . fmap render
|
||||
|
||||
render Nothing = simpleExpr $ text "_"
|
||||
render Nothing = simpleExpr $ "_"
|
||||
render (Just (NValue (reverse -> p:_) _)) = go (_originExpr p)
|
||||
render (Just (NValue _ _)) = simpleExpr $ text "?"
|
||||
-- simpleExpr $ foldr ((<$>) . parens . indent 2 . withoutParens
|
||||
render (Just (NValue _ _)) = simpleExpr "?"
|
||||
-- simpleExpr $ foldr ((\x y -> vsep [x, y]) . parens . indent 2 . withoutParens
|
||||
-- . go . originExpr)
|
||||
-- mempty (reverse ps)
|
||||
|
||||
exprFNixDoc :: NExprF NixDoc -> NixDoc
|
||||
exprFNixDoc :: NExprF (NixDoc ann) -> NixDoc ann
|
||||
exprFNixDoc = \case
|
||||
NConstant atom -> prettyAtom atom
|
||||
NStr str -> simpleExpr $ prettyString str
|
||||
NList [] -> simpleExpr $ lbracket <> rbracket
|
||||
NList xs -> simpleExpr $ group $
|
||||
nest 2 (vsep $ lbracket : map (wrapParens appOpNonAssoc) xs) <$> rbracket
|
||||
NList xs -> simpleExpr $ group $ nest 2 $ vsep $ concat $
|
||||
[ [lbracket]
|
||||
, map (wrapParens appOpNonAssoc) xs
|
||||
, [rbracket]
|
||||
]
|
||||
NSet [] -> simpleExpr $ lbrace <> rbrace
|
||||
NSet xs -> simpleExpr $ group $
|
||||
nest 2 (vsep $ lbrace : map prettyBind xs) <$> rbrace
|
||||
NSet xs -> simpleExpr $ group $ nest 2 $ vsep $ concat $
|
||||
[ [lbrace]
|
||||
, map prettyBind xs
|
||||
, [rbrace]
|
||||
]
|
||||
NRecSet [] -> simpleExpr $ recPrefix <> lbrace <> rbrace
|
||||
NRecSet xs -> simpleExpr $ group $
|
||||
nest 2 (vsep $ recPrefix <> lbrace : map prettyBind xs) <$> rbrace
|
||||
NAbs args body -> leastPrecedence $
|
||||
nest 2 ((prettyParams args <> colon) <$> withoutParens body)
|
||||
NRecSet xs -> simpleExpr $ group $ nest 2 $ vsep $ concat $
|
||||
[ [recPrefix <> lbrace]
|
||||
, map prettyBind xs
|
||||
, [rbrace]
|
||||
]
|
||||
NAbs args body -> leastPrecedence $ nest 2 $ vsep $
|
||||
[ prettyParams args <> colon
|
||||
, withoutParens body
|
||||
]
|
||||
NBinary NApp fun arg ->
|
||||
mkNixDoc (wrapParens appOp fun <+> wrapParens appOpNonAssoc arg) appOp
|
||||
NBinary op r1 r2 -> flip mkNixDoc opInfo $ hsep
|
||||
[ wrapParens (f NAssocLeft) r1
|
||||
, text $ unpack $ operatorName opInfo
|
||||
, pretty $ unpack $ operatorName opInfo
|
||||
, wrapParens (f NAssocRight) r2
|
||||
]
|
||||
where
|
||||
|
|
@ -203,18 +216,18 @@ exprFNixDoc = \case
|
|||
f x | associativity opInfo /= x = opInfo { associativity = NAssocNone }
|
||||
| otherwise = opInfo
|
||||
NUnary op r1 ->
|
||||
mkNixDoc (text (unpack (operatorName opInfo)) <> wrapParens opInfo r1) opInfo
|
||||
mkNixDoc (pretty (unpack (operatorName opInfo)) <> wrapParens opInfo r1) opInfo
|
||||
where opInfo = getUnaryOperator op
|
||||
NSelect r' attr o ->
|
||||
(if isJust o then leastPrecedence else flip mkNixDoc selectOp) $
|
||||
wrapPath selectOp r <> dot <> prettySelector attr <> ordoc
|
||||
where
|
||||
r = flip mkNixDoc selectOp $ wrapParens appOpNonAssoc r'
|
||||
ordoc = maybe empty (((space <> text "or") <+>) . wrapParens appOpNonAssoc) o
|
||||
ordoc = maybe mempty (((space <> "or") <+>) . wrapParens appOpNonAssoc) o
|
||||
NHasAttr r attr ->
|
||||
mkNixDoc (wrapParens hasAttrOp r <+> text "?" <+> prettySelector attr) hasAttrOp
|
||||
NEnvPath p -> simpleExpr $ text ("<" ++ p ++ ">")
|
||||
NLiteralPath p -> pathExpr $ text $ case p of
|
||||
mkNixDoc (wrapParens hasAttrOp r <+> "?" <+> prettySelector attr) hasAttrOp
|
||||
NEnvPath p -> simpleExpr $ pretty ("<" ++ p ++ ">")
|
||||
NLiteralPath p -> pathExpr $ pretty $ case p of
|
||||
"./" -> "./."
|
||||
"../" -> "../."
|
||||
".." -> "../."
|
||||
|
|
@ -223,20 +236,28 @@ exprFNixDoc = \case
|
|||
| "./" `isPrefixOf` txt -> txt
|
||||
| "../" `isPrefixOf` txt -> txt
|
||||
| otherwise -> "./" ++ txt
|
||||
NSym name -> simpleExpr $ text (unpack name)
|
||||
NLet binds body -> leastPrecedence $ group $ text "let" <$> indent 2 (
|
||||
vsep (map prettyBind binds)) <$> text "in" <+> withoutParens body
|
||||
NSym name -> simpleExpr $ pretty (unpack name)
|
||||
NLet binds body -> leastPrecedence $ group $ vsep $
|
||||
[ "let"
|
||||
, indent 2 (vsep (map prettyBind binds))
|
||||
, "in" <+> withoutParens body
|
||||
]
|
||||
NIf cond trueBody falseBody -> leastPrecedence $
|
||||
group $ nest 2 $ (text "if" <+> withoutParens cond) <$>
|
||||
( align (text "then" <+> withoutParens trueBody)
|
||||
<$> align (text "else" <+> withoutParens falseBody)
|
||||
)
|
||||
NWith scope body -> leastPrecedence $
|
||||
text "with" <+> withoutParens scope <> semi <$> align (withoutParens body)
|
||||
NAssert cond body -> leastPrecedence $
|
||||
text "assert" <+> withoutParens cond <> semi <$> align (withoutParens body)
|
||||
group $ nest 2 $ vsep $
|
||||
[ "if" <+> withoutParens cond
|
||||
, align ("then" <+> withoutParens trueBody)
|
||||
, align ("else" <+> withoutParens falseBody)
|
||||
]
|
||||
NWith scope body -> leastPrecedence $ vsep $
|
||||
[ "with" <+> withoutParens scope <> semi
|
||||
, align $ withoutParens body
|
||||
]
|
||||
NAssert cond body -> leastPrecedence $ vsep $
|
||||
[ "assert" <+> withoutParens cond <> semi
|
||||
, align $ withoutParens body
|
||||
]
|
||||
where
|
||||
recPrefix = text "rec" <> space
|
||||
recPrefix = "rec" <> space
|
||||
|
||||
fixate :: Functor f => (a -> f (Fix f)) -> Free f a -> Fix f
|
||||
fixate g = Fix . go
|
||||
|
|
@ -260,7 +281,7 @@ valueToExpr = transport go . check
|
|||
go (NVPathF p) = NLiteralPath p
|
||||
go (NVBuiltinF name _) = NSym $ Text.pack $ "builtins." ++ name
|
||||
|
||||
prettyNValueNF :: Functor m => NValueNF m -> Doc
|
||||
prettyNValueNF :: Functor m => NValueNF m -> Doc ann
|
||||
prettyNValueNF = prettyNix . valueToExpr
|
||||
|
||||
printNix :: Functor m => NValueNF m -> String
|
||||
|
|
@ -289,27 +310,33 @@ removeEffects = Free . fmap dethunk
|
|||
removeEffectsM :: MonadVar m => NValueF m (NThunk m) -> m (NValueNF m)
|
||||
removeEffectsM = fmap Free . traverse dethunk
|
||||
|
||||
prettyNValueF :: MonadVar m => NValueF m (NThunk m) -> m Doc
|
||||
prettyNValueF :: MonadVar m => NValueF m (NThunk m) -> m (Doc ann)
|
||||
prettyNValueF = fmap prettyNValueNF . removeEffectsM
|
||||
|
||||
prettyNValue :: MonadVar m => NValue m -> m Doc
|
||||
prettyNValue :: MonadVar m => NValue m -> m (Doc ann)
|
||||
prettyNValue (NValue _ v) = prettyNValueF v
|
||||
|
||||
prettyNValueProv :: MonadVar m => NValue m -> m Doc
|
||||
prettyNValueProv :: MonadVar m => NValue m -> m (Doc ann)
|
||||
prettyNValueProv = \case
|
||||
NValue [] v -> prettyNValueF v
|
||||
NValue ps v -> do
|
||||
v' <- prettyNValueF v
|
||||
pure $ v' </> indent 2 (parens (mconcat
|
||||
(text "from: " : map (prettyOriginExpr . _originExpr) ps)))
|
||||
|
||||
prettyNThunk :: MonadVar m => NThunk m -> m Doc
|
||||
pure $ fillSep $
|
||||
[ v'
|
||||
, indent 2 $ parens $ mconcat
|
||||
$ "from: "
|
||||
: map (prettyOriginExpr . _originExpr) ps
|
||||
]
|
||||
prettyNThunk :: MonadVar m => NThunk m -> m (Doc ann)
|
||||
prettyNThunk = \case
|
||||
t@(NThunk ps _) -> do
|
||||
v' <- fmap prettyNValueNF (dethunk t)
|
||||
pure $ v' </> indent 2 (parens (mconcat
|
||||
(text "thunk from: " : map (prettyOriginExpr . _originExpr) ps)))
|
||||
|
||||
pure $ fillSep $
|
||||
[ v'
|
||||
, indent 2 $ parens $ mconcat
|
||||
$ "thunk from: "
|
||||
: map (prettyOriginExpr . _originExpr) ps
|
||||
]
|
||||
dethunk :: MonadVar m => NThunk m -> m (NValueNF m)
|
||||
dethunk = \case
|
||||
NThunk _ (Value v) -> removeEffectsM (_baseValue v)
|
||||
|
|
|
|||
|
|
@ -35,6 +35,7 @@ import Control.Applicative
|
|||
import Control.Arrow (second)
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch
|
||||
import Control.Monad.Fail
|
||||
import Control.Monad.Fix
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
|
|
@ -67,13 +68,13 @@ newtype Reducer m a = Reducer
|
|||
{ runReducer :: ReaderT (Maybe FilePath, Scopes (Reducer m) NExprLoc)
|
||||
(StateT (HashMap FilePath NExprLoc) m) a }
|
||||
deriving (Functor, Applicative, Alternative, Monad, MonadPlus,
|
||||
MonadFix, MonadIO,
|
||||
MonadFix, MonadIO, MonadFail,
|
||||
MonadReader (Maybe FilePath, Scopes (Reducer m) NExprLoc),
|
||||
MonadState (HashMap FilePath NExprLoc))
|
||||
|
||||
staticImport
|
||||
:: forall m.
|
||||
(MonadIO m, Scoped NExprLoc m,
|
||||
(MonadIO m, Scoped NExprLoc m, MonadFail m,
|
||||
MonadReader (Maybe FilePath, Scopes m NExprLoc) m,
|
||||
MonadState (HashMap FilePath NExprLoc) m)
|
||||
=> SrcSpan -> FilePath -> m NExprLoc
|
||||
|
|
@ -111,7 +112,8 @@ staticImport pann path = do
|
|||
-- NSym_ _ var -> S.singleton var
|
||||
-- Compose (Ann _ x) -> fold x
|
||||
|
||||
reduceExpr :: MonadIO m => Maybe FilePath -> NExprLoc -> m NExprLoc
|
||||
reduceExpr :: (MonadIO m, MonadFail m)
|
||||
=> Maybe FilePath -> NExprLoc -> m NExprLoc
|
||||
reduceExpr mpath expr
|
||||
= (`evalStateT` M.empty)
|
||||
. (`runReaderT` (mpath, emptyScopes))
|
||||
|
|
@ -119,7 +121,7 @@ reduceExpr mpath expr
|
|||
$ cata reduce expr
|
||||
|
||||
reduce :: forall m.
|
||||
(MonadIO m, Scoped NExprLoc m,
|
||||
(MonadIO m, Scoped NExprLoc m, MonadFail m,
|
||||
MonadReader (Maybe FilePath, Scopes m NExprLoc) m,
|
||||
MonadState (HashMap FilePath NExprLoc) m)
|
||||
=> NExprLocF (m NExprLoc) -> m NExprLoc
|
||||
|
|
@ -143,7 +145,7 @@ reduce (NUnary_ uann op arg) = arg >>= \x -> case (op, x) of
|
|||
-- * Reduce an import to the actual imported expression.
|
||||
--
|
||||
-- * Reduce a lambda function by adding its name to the local
|
||||
-- scope and recursively reducing its body.
|
||||
-- scope and recursively reducing its body.
|
||||
reduce (NBinary_ bann NApp fun arg) = fun >>= \case
|
||||
f@(Fix (NSym_ _ "import")) -> arg >>= \case
|
||||
-- Fix (NEnvPath_ pann origPath) -> staticImport pann origPath
|
||||
|
|
@ -190,7 +192,7 @@ reduce base@(NSelect_ _ _ attrs _)
|
|||
_ -> findBind xs attrs
|
||||
-- Follow the attrpath recursively in sets.
|
||||
inspectSet (NSet_ _ binds) attrs = case findBind binds attrs of
|
||||
Just (NamedVar _ e _) -> case NE.uncons attrs of
|
||||
Just (NamedVar _ e _) -> case NE.uncons attrs of
|
||||
(_,Just attrs) -> inspectSet (unFix e) attrs
|
||||
_ -> pure e
|
||||
_ -> sId
|
||||
|
|
|
|||
|
|
@ -17,13 +17,13 @@ import Data.ByteString (ByteString)
|
|||
import qualified Data.ByteString as BS
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import qualified Data.Set as Set
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Data.Void
|
||||
import Nix.Expr.Types.Annotated
|
||||
import qualified System.Posix.Files as S
|
||||
import qualified System.Directory as S
|
||||
import Text.Megaparsec.Error
|
||||
import Text.Megaparsec.Pos (SourcePos(..))
|
||||
import Text.PrettyPrint.ANSI.Leijen
|
||||
|
||||
class Monad m => MonadFile m where
|
||||
readFile :: FilePath -> m ByteString
|
||||
|
|
@ -65,15 +65,11 @@ instance MonadFile IO where
|
|||
doesDirectoryExist = S.doesDirectoryExist
|
||||
getSymbolicLinkStatus = S.getSymbolicLinkStatus
|
||||
|
||||
posAndMsg :: SourcePos -> Doc -> ParseError t Void
|
||||
posAndMsg beg msg =
|
||||
FancyError (beg :| [])
|
||||
posAndMsg :: SourcePos -> Doc a -> ParseError s Void
|
||||
posAndMsg (SourcePos _ lineNo _) msg =
|
||||
FancyError (unPos lineNo)
|
||||
(Set.fromList [ErrorFail (show msg) :: ErrorFancy Void])
|
||||
|
||||
renderLocation :: MonadFile m => SrcSpan -> Doc -> m Doc
|
||||
renderLocation (SrcSpan beg@(SourcePos "<string>" _ _) _) msg =
|
||||
return $ text $ init $ parseErrorPretty @Char (posAndMsg beg msg)
|
||||
|
||||
renderLocation (SrcSpan beg@(SourcePos path _ _) _) msg = do
|
||||
contents <- Nix.Render.readFile path
|
||||
return $ text $ init $ parseErrorPretty' contents (posAndMsg beg msg)
|
||||
renderLocation :: Monad m => SrcSpan -> Doc a -> m (Doc a)
|
||||
renderLocation (SrcSpan beg@(SourcePos _ _ _) _) msg =
|
||||
return $ pretty $ init $ parseErrorPretty @String (posAndMsg beg msg)
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@ module Nix.Render.Frame where
|
|||
import Control.Monad.Reader
|
||||
import Data.Fix
|
||||
import Data.Typeable
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Nix.Eval
|
||||
import Nix.Exec
|
||||
import Nix.Expr
|
||||
|
|
@ -28,16 +29,15 @@ import Nix.Thunk
|
|||
import Nix.Utils
|
||||
import Nix.Value
|
||||
import Text.Megaparsec.Pos
|
||||
import qualified Text.PrettyPrint.ANSI.Leijen as P
|
||||
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
|
||||
#ifdef MIN_VERSION_pretty_show
|
||||
import qualified Text.Show.Pretty as PS
|
||||
#endif
|
||||
|
||||
renderFrames :: forall v e m.
|
||||
(MonadReader e m, Has e Options,
|
||||
MonadVar m, MonadFile m, Typeable m, Typeable v)
|
||||
=> Frames -> m Doc
|
||||
renderFrames
|
||||
:: forall v e m ann
|
||||
. ( MonadReader e m, Has e Options
|
||||
, MonadVar m, MonadFile m, Typeable m, Typeable v)
|
||||
=> Frames -> m (Doc ann)
|
||||
renderFrames [] = pure mempty
|
||||
renderFrames (x:xs) = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
|
|
@ -51,13 +51,13 @@ renderFrames (x:xs) = do
|
|||
concat <$> mapM (renderFrame @v) (reverse (x:xs))
|
||||
pure $ case frames of
|
||||
[] -> mempty
|
||||
_ -> foldr1 (P.<$>) frames
|
||||
_ -> vsep frames
|
||||
where
|
||||
go :: NixFrame -> [Doc]
|
||||
go :: NixFrame -> [Doc ann]
|
||||
go f = case framePos @v @m f of
|
||||
Just pos ->
|
||||
[text "While evaluating at "
|
||||
<> text (sourcePosPretty pos)
|
||||
["While evaluating at "
|
||||
<> pretty (sourcePosPretty pos)
|
||||
<> colon]
|
||||
Nothing -> []
|
||||
|
||||
|
|
@ -70,29 +70,29 @@ framePos (NixFrame _ f)
|
|||
_ -> Nothing
|
||||
| otherwise = Nothing
|
||||
|
||||
renderFrame :: forall v e m.
|
||||
renderFrame :: forall v e m ann.
|
||||
(MonadReader e m, Has e Options, MonadVar m,
|
||||
MonadFile m, Typeable m, Typeable v)
|
||||
=> NixFrame -> m [Doc]
|
||||
=> NixFrame -> m [Doc ann]
|
||||
renderFrame (NixFrame level f)
|
||||
| Just (e :: EvalFrame m v) <- fromException f = renderEvalFrame level e
|
||||
| Just (e :: ThunkLoop) <- fromException f = renderThunkLoop level e
|
||||
| Just (e :: ValueFrame m) <- fromException f = renderValueFrame level e
|
||||
| Just (e :: NormalLoop m) <- fromException f = renderNormalLoop level e
|
||||
| Just (e :: ExecFrame m) <- fromException f = renderExecFrame level e
|
||||
| Just (e :: ErrorCall) <- fromException f = pure [text (show e)]
|
||||
| Just (e :: ErrorCall) <- fromException f = pure [pretty (show e)]
|
||||
| otherwise = error $ "Unrecognized frame: " ++ show f
|
||||
|
||||
wrapExpr :: NExprF r -> NExpr
|
||||
wrapExpr x = Fix (Fix (NSym "<?>") <$ x)
|
||||
|
||||
renderEvalFrame :: (MonadReader e m, Has e Options, MonadFile m)
|
||||
=> NixLevel -> EvalFrame m v -> m [Doc]
|
||||
=> NixLevel -> EvalFrame m v -> m [Doc ann]
|
||||
renderEvalFrame level f = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
case f of
|
||||
EvaluatingExpr scope e@(Fix (Compose (Ann ann _))) -> do
|
||||
let scopeInfo | scopes opts = [string (show scope)]
|
||||
let scopeInfo | scopes opts = [pretty $ show scope]
|
||||
| otherwise = []
|
||||
fmap (\x -> scopeInfo ++ [x]) $ renderLocation ann
|
||||
=<< renderExpr level "While evaluating" "Expression" e
|
||||
|
|
@ -105,59 +105,64 @@ renderEvalFrame level f = do
|
|||
|
||||
Calling name ann ->
|
||||
fmap (:[]) $ renderLocation ann $
|
||||
text "While calling builtins." <> text name
|
||||
"While calling builtins." <> pretty name
|
||||
|
||||
_ -> pure []
|
||||
|
||||
renderExpr :: (MonadReader e m, Has e Options, MonadFile m)
|
||||
=> NixLevel -> String -> String -> NExprLoc -> m Doc
|
||||
=> NixLevel -> String -> String -> NExprLoc -> m (Doc ann)
|
||||
renderExpr _level longLabel shortLabel e@(Fix (Compose (Ann _ x))) = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
let rendered
|
||||
| verbose opts >= DebugInfo =
|
||||
#ifdef MIN_VERSION_pretty_show
|
||||
text (PS.ppShow (stripAnnotation e))
|
||||
pretty (PS.ppShow (stripAnnotation e))
|
||||
#else
|
||||
text (show (stripAnnotation e))
|
||||
pretty (show (stripAnnotation e))
|
||||
#endif
|
||||
| verbose opts >= Chatty =
|
||||
prettyNix (stripAnnotation e)
|
||||
| otherwise =
|
||||
prettyNix (Fix (Fix (NSym "<?>") <$ x))
|
||||
pure $ if verbose opts >= Chatty
|
||||
then text (longLabel ++ ":\n>>>>>>>>")
|
||||
P.<$> indent 2 rendered
|
||||
P.<$> text "<<<<<<<<"
|
||||
else text shortLabel <> text ": " </> rendered
|
||||
then vsep $
|
||||
[ pretty (longLabel ++ ":\n>>>>>>>>")
|
||||
, indent 2 rendered
|
||||
, "<<<<<<<<"
|
||||
]
|
||||
else pretty shortLabel <> fillSep [": ", rendered]
|
||||
|
||||
renderValueFrame :: (MonadReader e m, Has e Options,
|
||||
MonadFile m, MonadVar m)
|
||||
=> NixLevel -> ValueFrame m -> m [Doc]
|
||||
=> NixLevel -> ValueFrame m -> m [Doc ann]
|
||||
renderValueFrame level = fmap (:[]) . \case
|
||||
ForcingThunk -> pure $ text "ForcingThunk"
|
||||
ConcerningValue _v -> pure $ text "ConcerningValue"
|
||||
Comparison _ _ -> pure $ text "Comparing"
|
||||
Addition _ _ -> pure $ text "Adding"
|
||||
Division _ _ -> pure $ text "Dividing"
|
||||
Multiplication _ _ -> pure $ text "Multiplying"
|
||||
ForcingThunk -> pure "ForcingThunk"
|
||||
ConcerningValue _v -> pure "ConcerningValue"
|
||||
Comparison _ _ -> pure "Comparing"
|
||||
Addition _ _ -> pure "Adding"
|
||||
Division _ _ -> pure "Dividing"
|
||||
Multiplication _ _ -> pure "Multiplying"
|
||||
|
||||
Coercion x y ->
|
||||
pure $ text desc <> text (describeValue x)
|
||||
<> text " to " <> text (describeValue y)
|
||||
Coercion x y -> pure $ mconcat
|
||||
[ desc
|
||||
, pretty (describeValue x)
|
||||
, " to "
|
||||
, pretty (describeValue y)
|
||||
]
|
||||
where
|
||||
desc | level <= Error = "Cannot coerce "
|
||||
| otherwise = "While coercing "
|
||||
|
||||
CoercionToJsonNF _v -> pure $ text "CoercionToJsonNF"
|
||||
CoercionFromJson _j -> pure $ text "CoercionFromJson"
|
||||
ExpectationNF _t _v -> pure $ text "ExpectationNF"
|
||||
CoercionToJsonNF _v -> pure "CoercionToJsonNF"
|
||||
CoercionFromJson _j -> pure "CoercionFromJson"
|
||||
ExpectationNF _t _v -> pure "ExpectationNF"
|
||||
Expectation t v -> do
|
||||
v' <- renderValue level "" "" v
|
||||
pure $ text "Saw " <> v'
|
||||
<> text " but expected " <> text (describeValue t)
|
||||
pure $ "Saw " <> v'
|
||||
<> " but expected " <> pretty (describeValue t)
|
||||
|
||||
renderValue :: (MonadReader e m, Has e Options, MonadFile m, MonadVar m)
|
||||
=> NixLevel -> String -> String -> NValue m -> m Doc
|
||||
=> NixLevel -> String -> String -> NValue m -> m (Doc ann)
|
||||
renderValue _level _longLabel _shortLabel v = do
|
||||
opts :: Options <- asks (view hasLens)
|
||||
if values opts
|
||||
|
|
@ -165,23 +170,23 @@ renderValue _level _longLabel _shortLabel v = do
|
|||
else prettyNValue v
|
||||
|
||||
renderExecFrame :: (MonadReader e m, Has e Options, MonadVar m, MonadFile m)
|
||||
=> NixLevel -> ExecFrame m -> m [Doc]
|
||||
=> NixLevel -> ExecFrame m -> m [Doc ann]
|
||||
renderExecFrame level = \case
|
||||
Assertion ann v ->
|
||||
fmap (:[]) $ renderLocation ann
|
||||
=<< ((text "Assertion failed:" </>)
|
||||
=<< ((\d -> fillSep ["Assertion failed:", d])
|
||||
<$> renderValue level "" "" v)
|
||||
|
||||
renderThunkLoop :: (MonadReader e m, Has e Options, MonadFile m)
|
||||
=> NixLevel -> ThunkLoop -> m [Doc]
|
||||
=> NixLevel -> ThunkLoop -> m [Doc ann]
|
||||
renderThunkLoop _level = pure . (:[]) . \case
|
||||
ThunkLoop Nothing -> text "<<thunk loop>>"
|
||||
ThunkLoop Nothing -> "<<thunk loop>>"
|
||||
ThunkLoop (Just n) ->
|
||||
text $ "<<loop forcing thunk #" ++ show n ++ ">>"
|
||||
pretty $ "<<loop forcing thunk #" ++ show n ++ ">>"
|
||||
|
||||
renderNormalLoop :: (MonadReader e m, Has e Options, MonadFile m, MonadVar m)
|
||||
=> NixLevel -> NormalLoop m -> m [Doc]
|
||||
=> NixLevel -> NormalLoop m -> m [Doc ann]
|
||||
renderNormalLoop level = fmap (:[]) . \case
|
||||
NormalLoop v -> do
|
||||
v' <- renderValue level "" "" v
|
||||
pure $ text "<<loop during normalization forcing " <> v' <> text ">>"
|
||||
pure $ "<<loop during normalization forcing " <> v' <> ">>"
|
||||
|
|
|
|||
|
|
@ -16,7 +16,6 @@ module Nix.Scope where
|
|||
import Control.Applicative
|
||||
import Control.Monad.Reader
|
||||
import qualified Data.HashMap.Lazy as M
|
||||
import Data.Semigroup
|
||||
import Data.Text (Text)
|
||||
import Lens.Family2
|
||||
import Nix.Utils
|
||||
|
|
|
|||
|
|
@ -29,7 +29,6 @@ import Data.Hashable
|
|||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import GHC.Generics
|
||||
import Data.Semigroup
|
||||
|
||||
-- {-# WARNING hackyGetStringNoContext, hackyStringIgnoreContext, hackyMakeNixStringWithoutContext "This NixString function needs to be replaced" #-}
|
||||
|
||||
|
|
|
|||
|
|
@ -19,7 +19,6 @@ import Nix.Type.Type
|
|||
|
||||
import Data.Foldable hiding (toList)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Semigroup
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Typing Environment
|
||||
|
|
|
|||
|
|
@ -27,6 +27,7 @@ import Control.Applicative
|
|||
import Control.Arrow
|
||||
import Control.Monad.Catch
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.Fail
|
||||
import Control.Monad.Logic
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.Ref
|
||||
|
|
@ -40,7 +41,6 @@ import Data.Map (Map)
|
|||
import qualified Data.Map as Map
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.STRef
|
||||
import Data.Semigroup
|
||||
import qualified Data.Set as Set
|
||||
import Data.Text (Text)
|
||||
import Nix.Atoms
|
||||
|
|
@ -69,7 +69,7 @@ newtype Infer s a = Infer
|
|||
(StateT InferState (ExceptT InferError (ST s))) a
|
||||
}
|
||||
deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadFix,
|
||||
MonadReader (Set.Set TVar, Scopes (Infer s) (JThunk s)),
|
||||
MonadReader (Set.Set TVar, Scopes (Infer s) (JThunk s)), MonadFail,
|
||||
MonadState InferState, MonadError InferError)
|
||||
|
||||
-- | Inference state
|
||||
|
|
|
|||
|
|
@ -37,13 +37,6 @@ import System.Process
|
|||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
cabalCorrectlyGenerated :: Assertion
|
||||
cabalCorrectlyGenerated = do
|
||||
output <- readCreateProcess (shell "hpack") ""
|
||||
when ("modified manually" `isInfixOf` output) $
|
||||
errorWithoutStackTrace
|
||||
"Edit package.yaml and re-generate hnix.cabal by running \"hpack\""
|
||||
|
||||
ensureLangTestsPresent :: Assertion
|
||||
ensureLangTestsPresent = do
|
||||
exist <- fileExist "data/nix/tests/local.mk"
|
||||
|
|
@ -101,14 +94,11 @@ main = do
|
|||
let allOrLookup var = lookupEnv "ALL_TESTS" <|> lookupEnv var
|
||||
nixpkgsTestsEnv <- allOrLookup "NIXPKGS_TESTS"
|
||||
prettyTestsEnv <- lookupEnv "PRETTY_TESTS"
|
||||
hpackTestsEnv <- allOrLookup "HPACK_TESTS"
|
||||
|
||||
pwd <- getCurrentDirectory
|
||||
setEnv "NIX_REMOTE" ("local?root=" ++ pwd ++ "/")
|
||||
|
||||
defaultMain $ testGroup "hnix" $
|
||||
[ testCase "hnix.cabal correctly generated" cabalCorrectlyGenerated
|
||||
| isJust hpackTestsEnv ] ++
|
||||
[ ParserTests.tests
|
||||
, EvalTests.tests
|
||||
, PrettyTests.tests
|
||||
|
|
|
|||
|
|
@ -10,9 +10,10 @@ module ParserTests (tests) where
|
|||
|
||||
import Data.Fix
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Semigroup
|
||||
import Data.String.Interpolate.IsString
|
||||
import Data.Text (Text, unpack, pack)
|
||||
import Data.Text (Text, unpack)
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Data.Text.Prettyprint.Doc.Render.Text
|
||||
import Nix.Atoms
|
||||
import Nix.Expr
|
||||
import Nix.Parser
|
||||
|
|
@ -20,7 +21,6 @@ import Nix.Pretty
|
|||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import Test.Tasty.TH
|
||||
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>))
|
||||
|
||||
case_constant_int = assertParseText "234" $ mkInt 234
|
||||
|
||||
|
|
@ -394,9 +394,9 @@ assertParseFail str = case parseNixText str of
|
|||
assertParsePrint :: Text -> Text -> Assertion
|
||||
assertParsePrint src expect =
|
||||
let Success expr = parseNixTextLoc src
|
||||
result = displayS
|
||||
. renderPretty 0.4 80
|
||||
result = renderStrict
|
||||
. layoutPretty (LayoutOptions $ AvailablePerLine 80 0.4)
|
||||
. prettyNix
|
||||
. stripAnnotation
|
||||
$ expr
|
||||
in assertEqual "" expect (pack (result ""))
|
||||
in assertEqual "" expect result
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@ import Data.Char
|
|||
import Data.Fix
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Text.Prettyprint.Doc
|
||||
import Hedgehog
|
||||
import qualified Hedgehog.Gen as Gen
|
||||
import qualified Hedgehog.Range as Range
|
||||
|
|
@ -27,8 +28,6 @@ import Nix.Pretty
|
|||
import Test.Tasty
|
||||
import Test.Tasty.Hedgehog
|
||||
import Text.Megaparsec (Pos, SourcePos, mkPos)
|
||||
import Text.PrettyPrint.ANSI.Leijen ((</>), text)
|
||||
import qualified Text.PrettyPrint.ANSI.Leijen as P
|
||||
import qualified Text.Show.Pretty as PS
|
||||
|
||||
asciiString :: MonadGen m => m String
|
||||
|
|
@ -188,38 +187,38 @@ normalize = cata $ \case
|
|||
-- | Test that parse . pretty == id up to attribute position information.
|
||||
prop_prettyparse :: Monad m => NExpr -> PropertyT m ()
|
||||
prop_prettyparse p = do
|
||||
let prog = show (pretty p)
|
||||
let prog = show (prettyNix p)
|
||||
case parse (pack prog) of
|
||||
Failure s -> do
|
||||
footnote $ show $
|
||||
text "Parse failed:" </> text (show s)
|
||||
P.<$> P.indent 2 (pretty p)
|
||||
footnote $ show $ vsep
|
||||
[ fillSep ["Parse failed:", pretty (show s)]
|
||||
, indent 2 (prettyNix p)
|
||||
]
|
||||
discard
|
||||
Success v
|
||||
| equivUpToNormalization p v -> success
|
||||
| otherwise -> do
|
||||
let pp = normalise prog
|
||||
pv = normalise (show (pretty v))
|
||||
footnote $ show $
|
||||
text "----------------------------------------"
|
||||
P.<$> text "Expr before:" P.<$> P.indent 2 (text (PS.ppShow p))
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Expr after:" P.<$> P.indent 2 (text (PS.ppShow v))
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Pretty before:" P.<$> P.indent 2 (text prog)
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Pretty after:" P.<$> P.indent 2 (pretty v)
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Normalised before:" P.<$> P.indent 2 (text pp)
|
||||
P.<$> text "----------------------------------------"
|
||||
P.<$> text "Normalised after:" P.<$> P.indent 2 (text pv)
|
||||
P.<$> text "========================================"
|
||||
P.<$> text "Normalised diff:"
|
||||
P.<$> text (ppDiff (diff pp pv))
|
||||
P.<$> text "========================================"
|
||||
pv = normalise (show (prettyNix v))
|
||||
footnote $ show $ vsep $
|
||||
[ "----------------------------------------"
|
||||
, vsep ["Expr before:", indent 2 (pretty (PS.ppShow p))]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Expr after:", indent 2 (pretty (PS.ppShow v))]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Pretty before:", indent 2 (pretty prog)]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Pretty after:", indent 2 (prettyNix v)]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Normalised before:", indent 2 (pretty pp)]
|
||||
, "----------------------------------------"
|
||||
, vsep ["Normalised after:", indent 2 (pretty pv)]
|
||||
, "========================================"
|
||||
, vsep ["Normalised diff:", pretty (ppDiff (diff pp pv))]
|
||||
, "========================================"
|
||||
]
|
||||
assert (pp == pv)
|
||||
where
|
||||
pretty = prettyNix
|
||||
parse = parseNixText
|
||||
|
||||
normalise = unlines . map (reverse . dropWhile isSpace . reverse) . lines
|
||||
|
|
|
|||
Loading…
Reference in a new issue