{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Nix.Pretty where

import           Control.Applicative            ( (<|>) )
import           Control.Monad.Free
import           Data.Fix                       ( Fix(..), foldFix )
import           Data.HashMap.Lazy              ( toList )
import qualified Data.HashMap.Lazy             as M
import qualified Data.HashSet                  as HashSet
import           Data.List                      ( isPrefixOf
                                                , sort
                                                )
import           Data.List.NonEmpty             ( NonEmpty(..) )
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           Nix.Atoms
import           Nix.Cited
import           Nix.Expr
import           Nix.Expr.Strings
import           Nix.Normal
import           Nix.Parser
import           Nix.String
import           Nix.Thunk
import           Nix.Value
import           Prettyprinter
import           Text.Read                      ( readMaybe )

-- | This type represents a pretty printed nix expression
-- together with some information about the expression.
data NixDoc ann = NixDoc
  { -- | The rendered expression, without any parentheses.
    NixDoc ann -> Doc ann
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
    -- operator. It is needed to determine if we need to wrap the expression in
    -- parentheses.
  , NixDoc ann -> OperatorInfo
rootOp :: OperatorInfo
  , NixDoc ann -> Bool
wasPath :: Bool -- This is needed so that when a path is used in a selector path
                    -- we can add brackets appropriately
  }

mkNixDoc :: Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc :: Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc Doc ann
d OperatorInfo
o = NixDoc :: forall ann. Doc ann -> OperatorInfo -> Bool -> NixDoc ann
NixDoc { withoutParens :: Doc ann
withoutParens = Doc ann
d, rootOp :: OperatorInfo
rootOp = OperatorInfo
o, wasPath :: Bool
wasPath = Bool
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 ann -> NixDoc ann
simpleExpr :: Doc ann -> NixDoc ann
simpleExpr Doc ann
d = Doc ann -> OperatorInfo -> NixDoc ann
forall ann. Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc Doc ann
d (Int -> NAssoc -> Text -> OperatorInfo
OperatorInfo Int
forall a. Bounded a => a
minBound NAssoc
NAssocNone Text
"simple expr")

pathExpr :: Doc ann -> NixDoc ann
pathExpr :: Doc ann -> NixDoc ann
pathExpr Doc ann
d = (Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr Doc ann
d) { wasPath :: Bool
wasPath = Bool
True }

-- | An expression that behaves as if its root operator had a precedence lower
--   than all other operators. That ensures that the expression is wrapped in
--   parentheses 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 ann -> NixDoc ann
leastPrecedence :: Doc ann -> NixDoc ann
leastPrecedence =
  (Doc ann -> OperatorInfo -> NixDoc ann)
-> OperatorInfo -> Doc ann -> NixDoc ann
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc ann -> OperatorInfo -> NixDoc ann
forall ann. Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc (OperatorInfo -> Doc ann -> NixDoc ann)
-> OperatorInfo -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Int -> NAssoc -> Text -> OperatorInfo
OperatorInfo Int
forall a. Bounded a => a
maxBound NAssoc
NAssocNone Text
"least precedence"

appOp :: OperatorInfo
appOp :: OperatorInfo
appOp = NBinaryOp -> OperatorInfo
getBinaryOperator NBinaryOp
NApp

appOpNonAssoc :: OperatorInfo
appOpNonAssoc :: OperatorInfo
appOpNonAssoc = (NBinaryOp -> OperatorInfo
getBinaryOperator NBinaryOp
NApp) { associativity :: NAssoc
associativity = NAssoc
NAssocNone }

selectOp :: OperatorInfo
selectOp :: OperatorInfo
selectOp = NSpecialOp -> OperatorInfo
getSpecialOperator NSpecialOp
NSelectOp

hasAttrOp :: OperatorInfo
hasAttrOp :: OperatorInfo
hasAttrOp = NSpecialOp -> OperatorInfo
getSpecialOperator NSpecialOp
NHasAttrOp

wrapParens :: OperatorInfo -> NixDoc ann -> Doc ann
wrapParens :: OperatorInfo -> NixDoc ann -> Doc ann
wrapParens OperatorInfo
op NixDoc ann
sub
  | OperatorInfo -> Int
precedence (NixDoc ann -> OperatorInfo
forall ann. NixDoc ann -> OperatorInfo
rootOp NixDoc ann
sub) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< OperatorInfo -> Int
precedence OperatorInfo
op
  = NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
sub
  | OperatorInfo -> Int
precedence (NixDoc ann -> OperatorInfo
forall ann. NixDoc ann -> OperatorInfo
rootOp NixDoc ann
sub)
    Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== OperatorInfo -> Int
precedence OperatorInfo
op
    Bool -> Bool -> Bool
&& OperatorInfo -> NAssoc
associativity (NixDoc ann -> OperatorInfo
forall ann. NixDoc ann -> OperatorInfo
rootOp NixDoc ann
sub)
    NAssoc -> NAssoc -> Bool
forall a. Eq a => a -> a -> Bool
== OperatorInfo -> NAssoc
associativity OperatorInfo
op
    Bool -> Bool -> Bool
&& OperatorInfo -> NAssoc
associativity OperatorInfo
op
    NAssoc -> NAssoc -> Bool
forall a. Eq a => a -> a -> Bool
/= NAssoc
NAssocNone
  = NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
sub
  | Bool
otherwise
  = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
sub

-- Used in the selector case to print a path in a selector as
-- "${./abc}"
wrapPath :: OperatorInfo -> NixDoc ann -> Doc ann
wrapPath :: OperatorInfo -> NixDoc ann -> Doc ann
wrapPath OperatorInfo
op NixDoc ann
sub = if NixDoc ann -> Bool
forall ann. NixDoc ann -> Bool
wasPath NixDoc ann
sub
  then Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"$" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
sub)
  else OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens OperatorInfo
op NixDoc ann
sub

prettyString :: NString (NixDoc ann) -> Doc ann
prettyString :: NString (NixDoc ann) -> Doc ann
prettyString (DoubleQuoted [Antiquoted Text (NixDoc ann)]
parts) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Doc ann -> Doc ann)
-> ([Antiquoted Text (NixDoc ann)] -> Doc ann)
-> [Antiquoted Text (NixDoc ann)]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ([Doc ann] -> Doc ann)
-> ([Antiquoted Text (NixDoc ann)] -> [Doc ann])
-> [Antiquoted Text (NixDoc ann)]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Antiquoted Text (NixDoc ann) -> Doc ann)
-> [Antiquoted Text (NixDoc ann)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Antiquoted Text (NixDoc ann) -> Doc ann
forall ann. Antiquoted Text (NixDoc ann) -> Doc ann
prettyPart ([Antiquoted Text (NixDoc ann)] -> Doc ann)
-> [Antiquoted Text (NixDoc ann)] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Antiquoted Text (NixDoc ann)]
parts
 where
  prettyPart :: Antiquoted Text (NixDoc ann) -> Doc ann
prettyPart (Plain Text
t)      = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> (Text -> [Char]) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escape ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text
t
  prettyPart Antiquoted Text (NixDoc ann)
EscapedNewline = Doc ann
"''\\n"
  prettyPart (Antiquoted NixDoc ann
r) = Doc ann
"$" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
r)
  escape :: Char -> [Char]
escape Char
'"' = [Char]
"\\\""
  escape Char
x   = [Char] -> (Char -> [Char]) -> Maybe Char -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char
x] ((Char
'\\' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:) ([Char] -> [Char]) -> (Char -> [Char]) -> Char -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [])) (Maybe Char -> [Char]) -> Maybe Char -> [Char]
forall a b. (a -> b) -> a -> b
$ Char -> Maybe Char
toEscapeCode Char
x
prettyString (Indented Int
_ [Antiquoted Text (NixDoc ann)]
parts) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vcat
  [Doc ann
forall ann. Doc ann
dsquote, Doc ann
content, Doc ann
forall ann. Doc ann
dsquote]
 where
  dsquote :: Doc ann
dsquote = Doc ann
forall ann. Doc ann
squote Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
squote
  content :: Doc ann
content = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann)
-> ([Antiquoted Text (NixDoc ann)] -> [Doc ann])
-> [Antiquoted Text (NixDoc ann)]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Antiquoted Text (NixDoc ann)] -> Doc ann)
-> [[Antiquoted Text (NixDoc ann)]] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map [Antiquoted Text (NixDoc ann)] -> Doc ann
forall ann. [Antiquoted Text (NixDoc ann)] -> Doc ann
prettyLine ([[Antiquoted Text (NixDoc ann)]] -> [Doc ann])
-> ([Antiquoted Text (NixDoc ann)]
    -> [[Antiquoted Text (NixDoc ann)]])
-> [Antiquoted Text (NixDoc ann)]
-> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Antiquoted Text (NixDoc ann)]]
-> [[Antiquoted Text (NixDoc ann)]]
forall r. [[Antiquoted Text r]] -> [[Antiquoted Text r]]
stripLastIfEmpty ([[Antiquoted Text (NixDoc ann)]]
 -> [[Antiquoted Text (NixDoc ann)]])
-> ([Antiquoted Text (NixDoc ann)]
    -> [[Antiquoted Text (NixDoc ann)]])
-> [Antiquoted Text (NixDoc ann)]
-> [[Antiquoted Text (NixDoc ann)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Antiquoted Text (NixDoc ann)] -> [[Antiquoted Text (NixDoc ann)]]
forall r. [Antiquoted Text r] -> [[Antiquoted Text r]]
splitLines ([Antiquoted Text (NixDoc ann)] -> Doc ann)
-> [Antiquoted Text (NixDoc ann)] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Antiquoted Text (NixDoc ann)]
parts
  stripLastIfEmpty :: [[Antiquoted Text r]] -> [[Antiquoted Text r]]
stripLastIfEmpty = [[Antiquoted Text r]] -> [[Antiquoted Text r]]
forall a. [a] -> [a]
reverse ([[Antiquoted Text r]] -> [[Antiquoted Text r]])
-> ([[Antiquoted Text r]] -> [[Antiquoted Text r]])
-> [[Antiquoted Text r]]
-> [[Antiquoted Text r]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Antiquoted Text r]] -> [[Antiquoted Text r]]
forall r. [[Antiquoted Text r]] -> [[Antiquoted Text r]]
f ([[Antiquoted Text r]] -> [[Antiquoted Text r]])
-> ([[Antiquoted Text r]] -> [[Antiquoted Text r]])
-> [[Antiquoted Text r]]
-> [[Antiquoted Text r]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Antiquoted Text r]] -> [[Antiquoted Text r]]
forall a. [a] -> [a]
reverse   where
    f :: [[Antiquoted Text r]] -> [[Antiquoted Text r]]
f ([Plain Text
t] : [[Antiquoted Text r]]
xs) | Text -> Bool
Text.null (Text -> Text
strip Text
t) = [[Antiquoted Text r]]
xs
    f [[Antiquoted Text r]]
xs = [[Antiquoted Text r]]
xs
  prettyLine :: [Antiquoted Text (NixDoc ann)] -> Doc ann
prettyLine = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ([Doc ann] -> Doc ann)
-> ([Antiquoted Text (NixDoc ann)] -> [Doc ann])
-> [Antiquoted Text (NixDoc ann)]
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Antiquoted Text (NixDoc ann) -> Doc ann)
-> [Antiquoted Text (NixDoc ann)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Antiquoted Text (NixDoc ann) -> Doc ann
forall ann. Antiquoted Text (NixDoc ann) -> Doc ann
prettyPart
  prettyPart :: Antiquoted Text (NixDoc ann) -> Doc ann
prettyPart (Plain Text
t) =
    [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> (Text -> [Char]) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack (Text -> [Char]) -> (Text -> Text) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replace Text
"${" Text
"''${" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text -> Text
replace Text
"''" Text
"'''" (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text
t
  prettyPart Antiquoted Text (NixDoc ann)
EscapedNewline = Doc ann
"\\n"
  prettyPart (Antiquoted NixDoc ann
r) = Doc ann
"$" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
r)

prettyParams :: Params (NixDoc ann) -> Doc ann
prettyParams :: Params (NixDoc ann) -> Doc ann
prettyParams (Param Text
n           ) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> [Char] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpack Text
n
prettyParams (ParamSet ParamSet (NixDoc ann)
s Bool
v Maybe Text
mname) = ParamSet (NixDoc ann) -> Bool -> Doc ann
forall ann. ParamSet (NixDoc ann) -> Bool -> Doc ann
prettyParamSet ParamSet (NixDoc ann)
s Bool
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> case Maybe Text
mname of
  Maybe Text
Nothing -> Doc ann
forall a. Monoid a => a
mempty
  Just Text
name | Text -> Bool
Text.null Text
name -> Doc ann
forall a. Monoid a => a
mempty
            | Bool
otherwise      -> Doc ann
"@" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> [Char]
unpack Text
name)

prettyParamSet :: ParamSet (NixDoc ann) -> Bool -> Doc ann
prettyParamSet :: ParamSet (NixDoc ann) -> Bool -> Doc ann
prettyParamSet ParamSet (NixDoc ann)
args Bool
var = Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
encloseSep
  (Doc ann
forall ann. Doc ann
lbrace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space)
  (Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rbrace))
  Doc ann
forall ann. Doc ann
sep
  (((Text, Maybe (NixDoc ann)) -> Doc ann)
-> ParamSet (NixDoc ann) -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Maybe (NixDoc ann)) -> Doc ann
forall ann. (Text, Maybe (NixDoc ann)) -> Doc ann
prettySetArg ParamSet (NixDoc ann)
args [Doc ann] -> [Doc ann] -> [Doc ann]
forall a. [a] -> [a] -> [a]
++ [Doc ann]
prettyVariadic)
 where
  prettySetArg :: (Text, Maybe (NixDoc ann)) -> Doc ann
prettySetArg (Text
n, Maybe (NixDoc ann)
maybeDef) = case Maybe (NixDoc ann)
maybeDef of
    Maybe (NixDoc ann)
Nothing -> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> [Char]
unpack Text
n)
    Just NixDoc ann
v  -> [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> [Char]
unpack Text
n) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"?" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
v
  prettyVariadic :: [Doc ann]
prettyVariadic = [ Doc ann
"..." | Bool
var ]
  sep :: Doc ann
sep            = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space)

prettyBind :: Binding (NixDoc ann) -> Doc ann
prettyBind :: Binding (NixDoc ann) -> Doc ann
prettyBind (NamedVar NAttrPath (NixDoc ann)
n NixDoc ann
v SourcePos
_p) =
  NAttrPath (NixDoc ann) -> Doc ann
forall ann. NAttrPath (NixDoc ann) -> Doc ann
prettySelector NAttrPath (NixDoc ann)
n Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
v Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
prettyBind (Inherit Maybe (NixDoc ann)
s [NKeyName (NixDoc ann)]
ns SourcePos
_p) =
  Doc ann
"inherit" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
scope Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep ((NKeyName (NixDoc ann) -> Doc ann)
-> [NKeyName (NixDoc ann)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map NKeyName (NixDoc ann) -> Doc ann
forall ann. NKeyName (NixDoc ann) -> Doc ann
prettyKeyName [NKeyName (NixDoc ann)]
ns)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi
  where scope :: Doc ann
scope = Doc ann -> (NixDoc ann -> Doc ann) -> Maybe (NixDoc ann) -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty ((Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space) (Doc ann -> Doc ann)
-> (NixDoc ann -> Doc ann) -> NixDoc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (Doc ann -> Doc ann)
-> (NixDoc ann -> Doc ann) -> NixDoc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens) Maybe (NixDoc ann)
s

prettyKeyName :: NKeyName (NixDoc ann) -> Doc ann
prettyKeyName :: NKeyName (NixDoc ann) -> Doc ann
prettyKeyName (StaticKey Text
"") = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes Doc ann
""
prettyKeyName (StaticKey Text
key) | Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Text
key HashSet Text
reservedNames =
  Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
dquotes (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> [Char] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpack Text
key
prettyKeyName (StaticKey  Text
key) = [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> (Text -> [Char]) -> Text -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text
key
prettyKeyName (DynamicKey Antiquoted (NString (NixDoc ann)) (NixDoc ann)
key) = NString (NixDoc ann)
-> (NString (NixDoc ann) -> Doc ann)
-> (NixDoc ann -> Doc ann)
-> Antiquoted (NString (NixDoc ann)) (NixDoc ann)
-> Doc ann
forall v a r. v -> (v -> a) -> (r -> a) -> Antiquoted v r -> a
runAntiquoted
  ([Antiquoted Text (NixDoc ann)] -> NString (NixDoc ann)
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Text -> Antiquoted Text (NixDoc ann)
forall v r. v -> Antiquoted v r
Plain Text
"\n"])
  NString (NixDoc ann) -> Doc ann
forall ann. NString (NixDoc ann) -> Doc ann
prettyString
  ((Doc ann
"$" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>) (Doc ann -> Doc ann)
-> (NixDoc ann -> Doc ann) -> NixDoc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces (Doc ann -> Doc ann)
-> (NixDoc ann -> Doc ann) -> NixDoc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens)
  Antiquoted (NString (NixDoc ann)) (NixDoc ann)
key

prettySelector :: NAttrPath (NixDoc ann) -> Doc ann
prettySelector :: NAttrPath (NixDoc ann) -> Doc ann
prettySelector = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat ([Doc ann] -> Doc ann)
-> (NAttrPath (NixDoc ann) -> [Doc ann])
-> NAttrPath (NixDoc ann)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc ann
forall ann. Doc ann
dot ([Doc ann] -> [Doc ann])
-> (NAttrPath (NixDoc ann) -> [Doc ann])
-> NAttrPath (NixDoc ann)
-> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NKeyName (NixDoc ann) -> Doc ann)
-> [NKeyName (NixDoc ann)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map NKeyName (NixDoc ann) -> Doc ann
forall ann. NKeyName (NixDoc ann) -> Doc ann
prettyKeyName ([NKeyName (NixDoc ann)] -> [Doc ann])
-> (NAttrPath (NixDoc ann) -> [NKeyName (NixDoc ann)])
-> NAttrPath (NixDoc ann)
-> [Doc ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NAttrPath (NixDoc ann) -> [NKeyName (NixDoc ann)]
forall a. NonEmpty a -> [a]
NE.toList

prettyAtom :: NAtom -> NixDoc ann
prettyAtom :: NAtom -> NixDoc ann
prettyAtom NAtom
atom = Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> [Char] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ NAtom -> Text
atomText NAtom
atom

prettyNix :: NExpr -> Doc ann
prettyNix :: NExpr -> Doc ann
prettyNix = NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens (NixDoc ann -> Doc ann)
-> (NExpr -> NixDoc ann) -> NExpr -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NExprF (NixDoc ann) -> NixDoc ann) -> NExpr -> NixDoc ann
forall (f :: * -> *) a. Functor f => (f a -> a) -> Fix f -> a
foldFix NExprF (NixDoc ann) -> NixDoc ann
forall ann. NExprF (NixDoc ann) -> NixDoc ann
exprFNixDoc

instance HasCitations1 m v f
  => HasCitations m v (NValue' t f m a) where
  citations :: NValue' t f m a -> [Provenance m v]
citations (NValue f (NValueF (NValue t f m) m a)
f) = f (NValueF (NValue t f m) m a) -> [Provenance m v]
forall (m :: * -> *) v (f :: * -> *) a.
HasCitations1 m v f =>
f a -> [Provenance m v]
citations1 f (NValueF (NValue t f m) m a)
f
  addProvenance :: Provenance m v -> NValue' t f m a -> NValue' t f m a
addProvenance Provenance m v
x (NValue f (NValueF (NValue t f m) m a)
f) = f (NValueF (NValue t f m) m a) -> NValue' t f m a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue (Provenance m v
-> f (NValueF (NValue t f m) m a) -> f (NValueF (NValue t f m) m a)
forall (m :: * -> *) v (f :: * -> *) a.
HasCitations1 m v f =>
Provenance m v -> f a -> f a
addProvenance1 Provenance m v
x f (NValueF (NValue t f m) m a)
f)

instance (HasCitations1 m v f, HasCitations m v t)
  => HasCitations m v (NValue t f m) where
  citations :: NValue t f m -> [Provenance m v]
citations (Pure t
t) = t -> [Provenance m v]
forall (m :: * -> *) v a.
HasCitations m v a =>
a -> [Provenance m v]
citations t
t
  citations (Free NValue' t f m (NValue t f m)
v) = NValue' t f m (NValue t f m) -> [Provenance m v]
forall (m :: * -> *) v a.
HasCitations m v a =>
a -> [Provenance m v]
citations NValue' t f m (NValue t f m)
v
  addProvenance :: Provenance m v -> NValue t f m -> NValue t f m
addProvenance Provenance m v
x (Pure t
t) = t -> NValue t f m
forall (f :: * -> *) a. a -> Free f a
Pure (Provenance m v -> t -> t
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance Provenance m v
x t
t)
  addProvenance Provenance m v
x (Free NValue' t f m (NValue t f m)
v) = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (Provenance m v
-> NValue' t f m (NValue t f m) -> NValue' t f m (NValue t f m)
forall (m :: * -> *) v a.
HasCitations m v a =>
Provenance m v -> a -> a
addProvenance Provenance m v
x NValue' t f m (NValue t f m)
v)

prettyOriginExpr
  :: forall t f m ann
   . HasCitations1 m (NValue t f m) f
  => NExprLocF (Maybe (NValue t f m))
  -> Doc ann
prettyOriginExpr :: NExprLocF (Maybe (NValue t f m)) -> Doc ann
prettyOriginExpr = NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens (NixDoc ann -> Doc ann)
-> (NExprLocF (Maybe (NValue t f m)) -> NixDoc ann)
-> NExprLocF (Maybe (NValue t f m))
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NExprLocF (Maybe (NValue t f m)) -> NixDoc ann
forall ann.
Compose (Ann ann) NExprF (Maybe (NValue t f m)) -> NixDoc ann
go
 where
  go :: Compose (Ann ann) NExprF (Maybe (NValue t f m)) -> NixDoc ann
go = NExprF (NixDoc ann) -> NixDoc ann
forall ann. NExprF (NixDoc ann) -> NixDoc ann
exprFNixDoc (NExprF (NixDoc ann) -> NixDoc ann)
-> (Compose (Ann ann) NExprF (Maybe (NValue t f m))
    -> NExprF (NixDoc ann))
-> Compose (Ann ann) NExprF (Maybe (NValue t f m))
-> NixDoc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann ann (NExprF (NixDoc ann)) -> NExprF (NixDoc ann)
forall ann a. Ann ann a -> a
annotated (Ann ann (NExprF (NixDoc ann)) -> NExprF (NixDoc ann))
-> (Compose (Ann ann) NExprF (Maybe (NValue t f m))
    -> Ann ann (NExprF (NixDoc ann)))
-> Compose (Ann ann) NExprF (Maybe (NValue t f m))
-> NExprF (NixDoc ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (Ann ann) NExprF (NixDoc ann)
-> Ann ann (NExprF (NixDoc ann))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (Ann ann) NExprF (NixDoc ann)
 -> Ann ann (NExprF (NixDoc ann)))
-> (Compose (Ann ann) NExprF (Maybe (NValue t f m))
    -> Compose (Ann ann) NExprF (NixDoc ann))
-> Compose (Ann ann) NExprF (Maybe (NValue t f m))
-> Ann ann (NExprF (NixDoc ann))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (NValue t f m) -> NixDoc ann)
-> Compose (Ann ann) NExprF (Maybe (NValue t f m))
-> Compose (Ann ann) NExprF (NixDoc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (NValue t f m) -> NixDoc ann
render

  render :: Maybe (NValue t f m) -> NixDoc ann
  render :: Maybe (NValue t f m) -> NixDoc ann
render Maybe (NValue t f m)
Nothing = Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr Doc ann
"_"
  render (Just (Free ([Provenance m (NValue t f m)] -> [Provenance m (NValue t f m)]
forall a. [a] -> [a]
reverse ([Provenance m (NValue t f m)] -> [Provenance m (NValue t f m)])
-> (NValue' t f m (NValue t f m) -> [Provenance m (NValue t f m)])
-> NValue' t f m (NValue t f m)
-> [Provenance m (NValue t f m)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v a. HasCitations m v a => a -> [Provenance m v]
forall (m :: * -> *) v a.
HasCitations m v a =>
a -> [Provenance m v]
citations @m -> Provenance m (NValue t f m)
p:[Provenance m (NValue t f m)]
_))) = NExprLocF (Maybe (NValue t f m)) -> NixDoc ann
forall ann.
Compose (Ann ann) NExprF (Maybe (NValue t f m)) -> NixDoc ann
go (Provenance m (NValue t f m) -> NExprLocF (Maybe (NValue t f m))
forall (m :: * -> *) v. Provenance m v -> NExprLocF (Maybe v)
_originExpr Provenance m (NValue t f m)
p)
  render Maybe (NValue t f m)
_       = Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr Doc ann
"?"
    -- render (Just (NValue (citations -> ps))) =
        -- simpleExpr $ foldr ((\x y -> vsep [x, y]) . parens . indent 2 . withoutParens
        --                           . go . originExpr)
        --     mempty (reverse ps)

exprFNixDoc :: NExprF (NixDoc ann) -> NixDoc ann
exprFNixDoc :: NExprF (NixDoc ann) -> NixDoc ann
exprFNixDoc = \case
  NConstant NAtom
atom -> NAtom -> NixDoc ann
forall ann. NAtom -> NixDoc ann
prettyAtom NAtom
atom
  NStr      NString (NixDoc ann)
str  -> Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ NString (NixDoc ann) -> Doc ann
forall ann. NString (NixDoc ann) -> Doc ann
prettyString NString (NixDoc ann)
str
  NList     []   -> Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
forall ann. Doc ann
lbracket Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rbracket
  NList [NixDoc ann]
xs ->
    Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr
      (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [[Doc ann]] -> [Doc ann]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      ([[Doc ann]] -> [Doc ann]) -> [[Doc ann]] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ [[Doc ann
forall ann. Doc ann
lbracket], (NixDoc ann -> Doc ann) -> [NixDoc ann] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens OperatorInfo
appOpNonAssoc) [NixDoc ann]
xs, [Doc ann
forall ann. Doc ann
rbracket]]
  NSet NRecordType
NNonRecursive [] -> Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
forall ann. Doc ann
lbrace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rbrace
  NSet NRecordType
NNonRecursive [Binding (NixDoc ann)]
xs ->
    Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr
      (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [[Doc ann]] -> [Doc ann]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      ([[Doc ann]] -> [Doc ann]) -> [[Doc ann]] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ [[Doc ann
forall ann. Doc ann
lbrace], (Binding (NixDoc ann) -> Doc ann)
-> [Binding (NixDoc ann)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Binding (NixDoc ann) -> Doc ann
forall ann. Binding (NixDoc ann) -> Doc ann
prettyBind [Binding (NixDoc ann)]
xs, [Doc ann
forall ann. Doc ann
rbrace]]
  NSet NRecordType
NRecursive [] -> Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
forall ann. Doc ann
recPrefix Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
lbrace Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
rbrace
  NSet NRecordType
NRecursive [Binding (NixDoc ann)]
xs ->
    Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr
      (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [[Doc ann]] -> [Doc ann]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      ([[Doc ann]] -> [Doc ann]) -> [[Doc ann]] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ [[Doc ann
forall ann. Doc ann
recPrefix Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
lbrace], (Binding (NixDoc ann) -> Doc ann)
-> [Binding (NixDoc ann)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Binding (NixDoc ann) -> Doc ann
forall ann. Binding (NixDoc ann) -> Doc ann
prettyBind [Binding (NixDoc ann)]
xs, [Doc ann
forall ann. Doc ann
rbrace]]
  NAbs Params (NixDoc ann)
args NixDoc ann
body ->
    Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
leastPrecedence
      (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Params (NixDoc ann) -> Doc ann
forall ann. Params (NixDoc ann) -> Doc ann
prettyParams Params (NixDoc ann)
args Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon, NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
body]
  NBinary NBinaryOp
NApp NixDoc ann
fun NixDoc ann
arg ->
    Doc ann -> OperatorInfo -> NixDoc ann
forall ann. Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc (OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens OperatorInfo
appOp NixDoc ann
fun Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens OperatorInfo
appOpNonAssoc NixDoc ann
arg) OperatorInfo
appOp
  NBinary NBinaryOp
op NixDoc ann
r1 NixDoc ann
r2 -> (Doc ann -> OperatorInfo -> NixDoc ann)
-> OperatorInfo -> Doc ann -> NixDoc ann
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc ann -> OperatorInfo -> NixDoc ann
forall ann. Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc OperatorInfo
opInfo (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep
    [ OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens (NAssoc -> OperatorInfo
f NAssoc
NAssocLeft) NixDoc ann
r1
    , [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> [Char] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ OperatorInfo -> Text
operatorName OperatorInfo
opInfo
    , OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens (NAssoc -> OperatorInfo
f NAssoc
NAssocRight) NixDoc ann
r2
    ]
   where
    opInfo :: OperatorInfo
opInfo = NBinaryOp -> OperatorInfo
getBinaryOperator NBinaryOp
op
    f :: NAssoc -> OperatorInfo
f NAssoc
x | OperatorInfo -> NAssoc
associativity OperatorInfo
opInfo NAssoc -> NAssoc -> Bool
forall a. Eq a => a -> a -> Bool
/= NAssoc
x = OperatorInfo
opInfo { associativity :: NAssoc
associativity = NAssoc
NAssocNone }
        | Bool
otherwise                 = OperatorInfo
opInfo
  NUnary NUnaryOp
op NixDoc ann
r1 -> Doc ann -> OperatorInfo -> NixDoc ann
forall ann. Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc
    ([Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> [Char]
unpack (OperatorInfo -> Text
operatorName OperatorInfo
opInfo)) Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens OperatorInfo
opInfo NixDoc ann
r1)
    OperatorInfo
opInfo
    where opInfo :: OperatorInfo
opInfo = NUnaryOp -> OperatorInfo
getUnaryOperator NUnaryOp
op
  NSelect NixDoc ann
r' NAttrPath (NixDoc ann)
attr Maybe (NixDoc ann)
o ->
    (if Maybe (NixDoc ann) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (NixDoc ann)
o then Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
leastPrecedence else (Doc ann -> OperatorInfo -> NixDoc ann)
-> OperatorInfo -> Doc ann -> NixDoc ann
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc ann -> OperatorInfo -> NixDoc ann
forall ann. Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc OperatorInfo
selectOp)
      (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$  OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapPath OperatorInfo
selectOp NixDoc ann
r
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
dot
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> NAttrPath (NixDoc ann) -> Doc ann
forall ann. NAttrPath (NixDoc ann) -> Doc ann
prettySelector NAttrPath (NixDoc ann)
attr
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
ordoc
   where
    r :: NixDoc ann
r     = (Doc ann -> OperatorInfo -> NixDoc ann)
-> OperatorInfo -> Doc ann -> NixDoc ann
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc ann -> OperatorInfo -> NixDoc ann
forall ann. Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc OperatorInfo
selectOp (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens OperatorInfo
appOpNonAssoc NixDoc ann
r'
    ordoc :: Doc ann
ordoc = Doc ann -> (NixDoc ann -> Doc ann) -> Maybe (NixDoc ann) -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
forall a. Monoid a => a
mempty (((Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"or") Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc ann -> Doc ann)
-> (NixDoc ann -> Doc ann) -> NixDoc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens OperatorInfo
appOpNonAssoc) Maybe (NixDoc ann)
o
  NHasAttr NixDoc ann
r NAttrPath (NixDoc ann)
attr ->
    Doc ann -> OperatorInfo -> NixDoc ann
forall ann. Doc ann -> OperatorInfo -> NixDoc ann
mkNixDoc (OperatorInfo -> NixDoc ann -> Doc ann
forall ann. OperatorInfo -> NixDoc ann -> Doc ann
wrapParens OperatorInfo
hasAttrOp NixDoc ann
r Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"?" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NAttrPath (NixDoc ann) -> Doc ann
forall ann. NAttrPath (NixDoc ann) -> Doc ann
prettySelector NAttrPath (NixDoc ann)
attr) OperatorInfo
hasAttrOp
  NEnvPath     [Char]
p -> Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char]
"<" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">")
  NLiteralPath [Char]
p -> Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
pathExpr (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char] -> Doc ann) -> [Char] -> Doc ann
forall a b. (a -> b) -> a -> b
$ case [Char]
p of
    [Char]
"./"  -> [Char]
"./."
    [Char]
"../" -> [Char]
"../."
    [Char]
".."  -> [Char]
"../."
    [Char]
txt | [Char]
"/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
txt   -> [Char]
txt
        | [Char]
"~/" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
txt  -> [Char]
txt
        | [Char]
"./" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
txt  -> [Char]
txt
        | [Char]
"../" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
txt -> [Char]
txt
        | Bool
otherwise              -> [Char]
"./" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
txt
  NSym Text
name -> Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> [Char]
unpack Text
name)
  NLet [Binding (NixDoc ann)]
binds NixDoc ann
body ->
    Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
leastPrecedence
      (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [ Doc ann
"let"
        , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ((Binding (NixDoc ann) -> Doc ann)
-> [Binding (NixDoc ann)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Binding (NixDoc ann) -> Doc ann
forall ann. Binding (NixDoc ann) -> Doc ann
prettyBind [Binding (NixDoc ann)]
binds))
        , Doc ann
"in" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
body
        ]
  NIf NixDoc ann
cond NixDoc ann
trueBody NixDoc ann
falseBody ->
    Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
leastPrecedence
      (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [ Doc ann
"if" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
cond
        , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann
"then" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
trueBody)
        , Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann
"else" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
falseBody)
        ]
  NWith NixDoc ann
scope NixDoc ann
body ->
    Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
leastPrecedence
      (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann
"with" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
scope Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi, Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
body]
  NAssert NixDoc ann
cond NixDoc ann
body ->
    Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
leastPrecedence
      (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
      ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann
"assert" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
cond Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
semi, Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ NixDoc ann -> Doc ann
forall ann. NixDoc ann -> Doc ann
withoutParens NixDoc ann
body]
  NSynHole Text
name -> Doc ann -> NixDoc ann
forall ann. Doc ann -> NixDoc ann
simpleExpr (Doc ann -> NixDoc ann) -> Doc ann -> NixDoc ann
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Char]
"^" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
unpack Text
name)
  where recPrefix :: Doc ann
recPrefix = Doc ann
"rec" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
space

valueToExpr :: forall t f m . MonadDataContext f m => NValue t f m -> NExpr
valueToExpr :: NValue t f m -> NExpr
valueToExpr = (t -> (NValue t f m -> NExpr) -> NExpr)
-> (NValue' t f m NExpr -> NExpr) -> NValue t f m -> NExpr
forall t (f :: * -> *) (m :: * -> *) r.
MonadDataContext f m =>
(t -> (NValue t f m -> r) -> r)
-> (NValue' t f m r -> r) -> NValue t f m -> r
iterNValue (\t
_ NValue t f m -> NExpr
_ -> NExpr
thk) NValue' t f m NExpr -> NExpr
phi
 where
  thk :: NExpr
thk = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr)
-> ([Char] -> NExprF NExpr) -> [Char] -> NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NExprF NExpr
forall r. Text -> NExprF r
NSym (Text -> NExprF NExpr)
-> ([Char] -> Text) -> [Char] -> NExprF NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> NExpr) -> [Char] -> NExpr
forall a b. (a -> b) -> a -> b
$ [Char]
"<CYCLE>"

  phi :: NValue' t f m NExpr -> NExpr
  phi :: NValue' t f m NExpr -> NExpr
phi (NVConstant' NAtom
a ) = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr) -> NExprF NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ NAtom -> NExprF NExpr
forall r. NAtom -> NExprF r
NConstant NAtom
a
  phi (NVStr'      NixString
ns) = NixString -> NExpr
mkStr NixString
ns
  phi (NVList'     [NExpr]
l ) = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr) -> NExprF NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ [NExpr] -> NExprF NExpr
forall r. [r] -> NExprF r
NList [NExpr]
l
  phi (NVSet' AttrSet NExpr
s AttrSet SourcePos
p    ) = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr) -> NExprF NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ NRecordType -> [Binding NExpr] -> NExprF NExpr
forall r. NRecordType -> [Binding r] -> NExprF r
NSet NRecordType
NNonRecursive
    [ NAttrPath NExpr -> NExpr -> SourcePos -> Binding NExpr
forall r. NAttrPath r -> r -> SourcePos -> Binding r
NamedVar (Text -> NKeyName NExpr
forall r. Text -> NKeyName r
StaticKey Text
k NKeyName NExpr -> [NKeyName NExpr] -> NAttrPath NExpr
forall a. a -> [a] -> NonEmpty a
:| []) NExpr
v (SourcePos -> Maybe SourcePos -> SourcePos
forall a. a -> Maybe a -> a
fromMaybe SourcePos
nullPos (Text -> AttrSet SourcePos -> Maybe SourcePos
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
k AttrSet SourcePos
p))
    | (Text
k, NExpr
v) <- AttrSet NExpr -> [(Text, NExpr)]
forall k v. HashMap k v -> [(k, v)]
toList AttrSet NExpr
s
    ]
  phi (NVClosure' Params ()
_ NValue t f m -> m NExpr
_   ) = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr)
-> ([Char] -> NExprF NExpr) -> [Char] -> NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NExprF NExpr
forall r. Text -> NExprF r
NSym (Text -> NExprF NExpr)
-> ([Char] -> Text) -> [Char] -> NExprF NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> NExpr) -> [Char] -> NExpr
forall a b. (a -> b) -> a -> b
$ [Char]
"<closure>"
  phi (NVPath' [Char]
p        ) = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr) -> NExprF NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ [Char] -> NExprF NExpr
forall r. [Char] -> NExprF r
NLiteralPath [Char]
p
  phi (NVBuiltin' [Char]
name NValue t f m -> m NExpr
_) = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr)
-> ([Char] -> NExprF NExpr) -> [Char] -> NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NExprF NExpr
forall r. Text -> NExprF r
NSym (Text -> NExprF NExpr)
-> ([Char] -> Text) -> [Char] -> NExprF NExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack ([Char] -> NExpr) -> [Char] -> NExpr
forall a b. (a -> b) -> a -> b
$ [Char]
"builtins." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name
  phi NValue' t f m NExpr
_                   = [Char] -> NExpr
forall a. HasCallStack => [Char] -> a
error [Char]
"Pattern synonyms foil completeness check"

  mkStr :: NixString -> NExpr
mkStr NixString
ns = NExprF NExpr -> NExpr
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (NExprF NExpr -> NExpr) -> NExprF NExpr -> NExpr
forall a b. (a -> b) -> a -> b
$ NString NExpr -> NExprF NExpr
forall r. NString r -> NExprF r
NStr (NString NExpr -> NExprF NExpr) -> NString NExpr -> NExprF NExpr
forall a b. (a -> b) -> a -> b
$ [Antiquoted Text NExpr] -> NString NExpr
forall r. [Antiquoted Text r] -> NString r
DoubleQuoted [Text -> Antiquoted Text NExpr
forall v r. v -> Antiquoted v r
Plain (NixString -> Text
hackyStringIgnoreContext NixString
ns)]

prettyNValue
  :: forall t f m ann . MonadDataContext f m => NValue t f m -> Doc ann
prettyNValue :: NValue t f m -> Doc ann
prettyNValue = NExpr -> Doc ann
forall ann. NExpr -> Doc ann
prettyNix (NExpr -> Doc ann)
-> (NValue t f m -> NExpr) -> NValue t f m -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValue t f m -> NExpr
forall t (f :: * -> *) (m :: * -> *).
MonadDataContext f m =>
NValue t f m -> NExpr
valueToExpr

prettyNValueProv
  :: forall t f m ann
   . ( HasCitations m (NValue t f m) t
     , HasCitations1 m (NValue t f m) f
     , MonadThunk t m (NValue t f m)
     , MonadDataContext f m
     )
  => NValue t f m
  -> Doc ann
prettyNValueProv :: NValue t f m -> Doc ann
prettyNValueProv NValue t f m
v = do
  let ps :: [Provenance m (NValue t f m)]
ps = NValue t f m -> [Provenance m (NValue t f m)]
forall (m :: * -> *) v a.
HasCitations m v a =>
a -> [Provenance m v]
citations @m @(NValue t f m) NValue t f m
v
  case [Provenance m (NValue t f m)]
ps of
    [] -> NValue t f m -> Doc ann
forall t (f :: * -> *) (m :: * -> *) ann.
MonadDataContext f m =>
NValue t f m -> Doc ann
prettyNValue NValue t f m
v
    [Provenance m (NValue t f m)]
ps ->
      let v' :: Doc ann
v' = NValue t f m -> Doc ann
forall t (f :: * -> *) (m :: * -> *) ann.
MonadDataContext f m =>
NValue t f m -> Doc ann
prettyNValue NValue t f m
v in
      [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep
        [ Doc ann
forall ann. Doc ann
v'
        , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2
        (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens
        (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"from: "
        Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Provenance m (NValue t f m) -> Doc ann)
-> [Provenance m (NValue t f m)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (NExprLocF (Maybe (NValue t f m)) -> Doc ann
forall t (f :: * -> *) (m :: * -> *) ann.
HasCitations1 m (NValue t f m) f =>
NExprLocF (Maybe (NValue t f m)) -> Doc ann
prettyOriginExpr (NExprLocF (Maybe (NValue t f m)) -> Doc ann)
-> (Provenance m (NValue t f m)
    -> NExprLocF (Maybe (NValue t f m)))
-> Provenance m (NValue t f m)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Provenance m (NValue t f m) -> NExprLocF (Maybe (NValue t f m))
forall (m :: * -> *) v. Provenance m v -> NExprLocF (Maybe v)
_originExpr) [Provenance m (NValue t f m)]
ps
        ]

prettyNThunk
  :: forall t f m ann
   . ( HasCitations m (NValue t f m) t
     , HasCitations1 m (NValue t f m) f
     , MonadThunk t m (NValue t f m)
     , MonadDataContext f m
     )
  => t
  -> m (Doc ann)
prettyNThunk :: t -> m (Doc ann)
prettyNThunk t
t = do
  let ps :: [Provenance m (NValue t f m)]
ps = t -> [Provenance m (NValue t f m)]
forall (m :: * -> *) v a.
HasCitations m v a =>
a -> [Provenance m v]
citations @m @(NValue t f m) @t t
t
  Doc ann
v' <- NValue t f m -> Doc ann
forall t (f :: * -> *) (m :: * -> *) ann.
MonadDataContext f m =>
NValue t f m -> Doc ann
prettyNValue (NValue t f m -> Doc ann) -> m (NValue t f m) -> m (Doc ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> m (NValue t f m)
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), MonadDataContext f m) =>
t -> m (NValue t f m)
dethunk t
t
  Doc ann -> m (Doc ann)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Doc ann -> m (Doc ann)) -> Doc ann -> m (Doc ann)
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
fillSep
    ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ [ Doc ann
v'
      , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens
      (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
      ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"thunk from: "
      Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (Provenance m (NValue t f m) -> Doc ann)
-> [Provenance m (NValue t f m)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map (NExprLocF (Maybe (NValue t f m)) -> Doc ann
forall t (f :: * -> *) (m :: * -> *) ann.
HasCitations1 m (NValue t f m) f =>
NExprLocF (Maybe (NValue t f m)) -> Doc ann
prettyOriginExpr (NExprLocF (Maybe (NValue t f m)) -> Doc ann)
-> (Provenance m (NValue t f m)
    -> NExprLocF (Maybe (NValue t f m)))
-> Provenance m (NValue t f m)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Provenance m (NValue t f m) -> NExprLocF (Maybe (NValue t f m))
forall (m :: * -> *) v. Provenance m v -> NExprLocF (Maybe v)
_originExpr) [Provenance m (NValue t f m)]
ps
      ]

-- | This function is used only by the testing code.
printNix :: forall t f m . MonadDataContext f m => NValue t f m -> String
printNix :: NValue t f m -> [Char]
printNix = (t -> (NValue t f m -> [Char]) -> [Char])
-> (NValue' t f m [Char] -> [Char]) -> NValue t f m -> [Char]
forall t (f :: * -> *) (m :: * -> *) r.
MonadDataContext f m =>
(t -> (NValue t f m -> r) -> r)
-> (NValue' t f m r -> r) -> NValue t f m -> r
iterNValue (\t
_ NValue t f m -> [Char]
_ -> [Char]
thk) NValue' t f m [Char] -> [Char]
phi
 where
  thk :: [Char]
thk = [Char]
"<thunk>"

  phi :: NValue' t f m String -> String
  phi :: NValue' t f m [Char] -> [Char]
phi (NVConstant' NAtom
a ) = Text -> [Char]
unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ NAtom -> Text
atomText NAtom
a
  phi (NVStr'      NixString
ns) = Text -> [Char]
forall a. Show a => a -> [Char]
show (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ NixString -> Text
hackyStringIgnoreContext NixString
ns
  phi (NVList'     [[Char]]
l ) = [Char]
"[ " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ]"
  phi (NVSet' AttrSet [Char]
s AttrSet SourcePos
_) =
    [Char]
"{ "
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
           [ [Char] -> [Char]
check (Text -> [Char]
unpack Text
k) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"; "
           | (Text
k, [Char]
v) <- [(Text, [Char])] -> [(Text, [Char])]
forall a. Ord a => [a] -> [a]
sort ([(Text, [Char])] -> [(Text, [Char])])
-> [(Text, [Char])] -> [(Text, [Char])]
forall a b. (a -> b) -> a -> b
$ AttrSet [Char] -> [(Text, [Char])]
forall k v. HashMap k v -> [(k, v)]
toList AttrSet [Char]
s
           ]
      [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}"
   where
    check :: [Char] -> [Char]
check [Char]
v = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe
      [Char]
v
      (   (Int -> [Char]) -> Maybe Int -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char]
surround ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) ([Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
v :: Maybe Int)
      Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Float -> [Char]) -> Maybe Float -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [Char]
surround ([Char] -> [Char]) -> (Float -> [Char]) -> Float -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> [Char]
forall a. Show a => a -> [Char]
show) ([Char] -> Maybe Float
forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
v :: Maybe Float)
      )
      where surround :: [Char] -> [Char]
surround [Char]
s = [Char]
"\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
  phi NVClosure'{}        = [Char]
"<<lambda>>"
  phi (NVPath' [Char]
fp       ) = [Char]
fp
  phi (NVBuiltin' [Char]
name NValue t f m -> m [Char]
_) = [Char]
"<<builtin " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">>"
  phi NValue' t f m [Char]
_                   = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"Pattern synonyms foil completeness check"