{-# language UndecidableInstances #-}
{-# language CPP #-}
{-# language ConstraintKinds #-}
{-# language DefaultSignatures #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language MultiWayIf #-}
module Nix.Render where
import Nix.Prelude
import qualified Data.Set as Set
import Nix.Utils.Fix1 ( Fix1T
, MonadFix1T
)
import Nix.Expr.Types ( NPos(..)
, NSourcePos(..)
)
import Nix.Expr.Types.Annotated
import Prettyprinter
import qualified System.Directory as S
import qualified System.PosixCompat.Files as S
import Text.Megaparsec.Error
import Text.Megaparsec.Pos
import qualified Data.Text as Text
class (MonadFail m, MonadIO m) => MonadFile m where
readFile :: Path -> m Text
default readFile :: (MonadTrans t, MonadIO m', MonadFile m', m ~ t m') => Path -> m Text
readFile = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => Path -> m Text
Nix.Prelude.readFile
listDirectory :: Path -> m [Path]
default listDirectory :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m [Path]
listDirectory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFile m => Path -> m [Path]
listDirectory
getCurrentDirectory :: m Path
default getCurrentDirectory :: (MonadTrans t, MonadFile m', m ~ t m') => m Path
getCurrentDirectory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadFile m => m Path
getCurrentDirectory
canonicalizePath :: Path -> m Path
default canonicalizePath :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m Path
canonicalizePath = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFile m => Path -> m Path
canonicalizePath
getHomeDirectory :: m Path
default getHomeDirectory :: (MonadTrans t, MonadFile m', m ~ t m') => m Path
getHomeDirectory = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadFile m => m Path
getHomeDirectory
doesPathExist :: Path -> m Bool
default doesPathExist :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m Bool
doesPathExist = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFile m => Path -> m Bool
doesPathExist
doesFileExist :: Path -> m Bool
default doesFileExist :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m Bool
doesFileExist = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFile m => Path -> m Bool
doesFileExist
doesDirectoryExist :: Path -> m Bool
default doesDirectoryExist :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m Bool
doesDirectoryExist = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFile m => Path -> m Bool
doesDirectoryExist
getSymbolicLinkStatus :: Path -> m S.FileStatus
default getSymbolicLinkStatus :: (MonadTrans t, MonadFile m', m ~ t m') => Path -> m S.FileStatus
getSymbolicLinkStatus = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFile m => Path -> m FileStatus
getSymbolicLinkStatus
instance MonadFile IO where
readFile :: Path -> IO Text
readFile = forall (m :: * -> *). MonadIO m => Path -> m Text
Nix.Prelude.readFile
listDirectory :: Path -> IO [Path]
listDirectory = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> IO [FilePath]
S.listDirectory
getCurrentDirectory :: IO Path
getCurrentDirectory = coerce :: forall a b. Coercible a b => a -> b
coerce IO FilePath
S.getCurrentDirectory
canonicalizePath :: Path -> IO Path
canonicalizePath = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> IO FilePath
S.canonicalizePath
getHomeDirectory :: IO Path
getHomeDirectory = coerce :: forall a b. Coercible a b => a -> b
coerce IO FilePath
S.getHomeDirectory
doesPathExist :: Path -> IO Bool
doesPathExist = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> IO Bool
S.doesPathExist
doesFileExist :: Path -> IO Bool
doesFileExist = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> IO Bool
S.doesFileExist
doesDirectoryExist :: Path -> IO Bool
doesDirectoryExist = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> IO Bool
S.doesDirectoryExist
getSymbolicLinkStatus :: Path -> IO FileStatus
getSymbolicLinkStatus = coerce :: forall a b. Coercible a b => a -> b
coerce FilePath -> IO FileStatus
S.getSymbolicLinkStatus
instance (MonadFix1T t m, MonadIO (Fix1T t m), MonadFail (Fix1T t m), MonadFile m) => MonadFile (Fix1T t m)
posAndMsg :: NSourcePos -> Doc a -> ParseError s Void
posAndMsg :: forall a s. NSourcePos -> Doc a -> ParseError s Void
posAndMsg (NSourcePos Path
_ (coerce :: forall a b. Coercible a b => a -> b
coerce -> Pos
lineNo) NPos
_) Doc a
msg =
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
FancyError
(Pos -> Int
unPos Pos
lineNo)
(forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one (forall e. FilePath -> ErrorFancy e
ErrorFail (forall b a. (Show a, IsString b) => a -> b
show Doc a
msg) :: ErrorFancy Void))
renderLocation :: MonadFile m => SrcSpan -> Doc a -> m (Doc a)
renderLocation :: forall (m :: * -> *) a.
MonadFile m =>
SrcSpan -> Doc a -> m (Doc a)
renderLocation (SrcSpan (NSourcePos Path
file (coerce :: forall a b. Coercible a b => a -> b
coerce -> Pos
begLine) (coerce :: forall a b. Coercible a b => a -> b
coerce -> Pos
begCol)) (NSourcePos Path
file' (coerce :: forall a b. Coercible a b => a -> b
coerce -> Pos
endLine) (coerce :: forall a b. Coercible a b => a -> b
coerce -> Pos
endCol))) Doc a
msg
| Path
file forall a. Eq a => a -> a -> Bool
== Path
file' Bool -> Bool -> Bool
&& Path
file forall a. Eq a => a -> a -> Bool
== Path
"<string>" Bool -> Bool -> Bool
&& Pos
begLine forall a. Eq a => a -> a -> Bool
== Pos
endLine =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Doc a
"In raw input string at position " forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (Pos -> Int
unPos Pos
begCol)
| Path
file forall a. Eq a => a -> a -> Bool
/= Path
"<string>" Bool -> Bool -> Bool
&& Path
file forall a. Eq a => a -> a -> Bool
== Path
file' =
forall a. a -> a -> Bool -> a
bool
(forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc a
msg)
(do
Doc a
txt <- forall (m :: * -> *) a.
MonadFile m =>
Path -> Pos -> Pos -> Pos -> Pos -> Doc a -> m (Doc a)
sourceContext Path
file Pos
begLine Pos
begCol Pos
endLine Pos
endCol Doc a
msg
pure $
forall ann. [Doc ann] -> Doc ann
vsep
[ Doc a
"In file " forall a. Semigroup a => a -> a -> a
<> forall a. Path -> Pos -> Pos -> Pos -> Pos -> Doc a
errorContext Path
file Pos
begLine Pos
begCol Pos
endLine Pos
endCol forall a. Semigroup a => a -> a -> a
<> Doc a
":"
, Doc a
txt
]
)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadFile m => Path -> m Bool
doesFileExist Path
file
renderLocation (SrcSpan NSourcePos
beg NSourcePos
end) Doc a
msg = forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Don't know how to render range from " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NSourcePos
beg forall a. Semigroup a => a -> a -> a
<>FilePath
" to " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NSourcePos
end forall a. Semigroup a => a -> a -> a
<>FilePath
" for fail: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Doc a
msg
errorContext :: Path -> Pos -> Pos -> Pos -> Pos -> Doc a
errorContext :: forall a. Path -> Pos -> Pos -> Pos -> Pos -> Doc a
errorContext (coerce :: forall a b. Coercible a b => a -> b
coerce @Path @FilePath -> FilePath
path) Pos
bl Pos
bc Pos
_el Pos
_ec =
forall a ann. Pretty a => a -> Doc ann
pretty FilePath
path forall a. Semigroup a => a -> a -> a
<> Doc a
":" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (Pos -> Int
unPos Pos
bl) forall a. Semigroup a => a -> a -> a
<> Doc a
":" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (Pos -> Int
unPos Pos
bc)
sourceContext
:: MonadFile m => Path -> Pos -> Pos -> Pos -> Pos -> Doc a -> m (Doc a)
sourceContext :: forall (m :: * -> *) a.
MonadFile m =>
Path -> Pos -> Pos -> Pos -> Pos -> Doc a -> m (Doc a)
sourceContext Path
path (Pos -> Int
unPos -> Int
begLine) (Pos -> Int
unPos -> Int
_begCol) (Pos -> Int
unPos -> Int
endLine) (Pos -> Int
unPos -> Int
_endCol) Doc a
msg
= do
let beg' :: Int
beg' = forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ Int
begLine forall a. Num a => a -> a -> a
- Int
3
end' :: Int
end' = Int
endLine forall a. Num a => a -> a -> a
+ Int
3
[Doc a]
ls <-
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a ann. Pretty a => a -> Doc ann
pretty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take (Int
end' forall a. Num a => a -> a -> a
- Int
beg')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (forall a. Enum a => a -> a
pred Int
beg')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. IsText t "lines" => t -> [t]
lines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadFile m => Path -> m Text
Nix.Render.readFile Path
path
let
longest :: Int
longest = Text -> Int
Text.length forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show forall a b. (a -> b) -> a -> b
$ Int
beg' forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc a]
ls forall a. Num a => a -> a -> a
- Int
1
pad :: Int -> Text
pad :: Int -> Text
pad Int
n =
let
ns :: Text
ns :: Text
ns = forall b a. (Show a, IsString b) => a -> b
show Int
n
nsp :: Text
nsp = Int -> Text -> Text
Text.replicate (Int
longest forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
ns) Text
" " forall a. Semigroup a => a -> a -> a
<> Text
ns
in
if
| Int
n forall a. Eq a => a -> a -> Bool
== Int
begLine Bool -> Bool -> Bool
&& Int
n forall a. Eq a => a -> a -> Bool
== Int
endLine -> Text
"==> " forall a. Semigroup a => a -> a -> a
<> Text
nsp forall a. Semigroup a => a -> a -> a
<> Text
" | "
| Int
n forall a. Ord a => a -> a -> Bool
>= Int
begLine Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
endLine -> Text
" > " forall a. Semigroup a => a -> a -> a
<> Text
nsp forall a. Semigroup a => a -> a -> a
<> Text
" | "
| Bool
otherwise -> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
nsp forall a. Semigroup a => a -> a -> a
<> Text
" | "
composeLine :: Int -> Doc a -> [Doc a]
composeLine Int
n Doc a
l =
forall x. One x => OneItem x -> x
one (forall a ann. Pretty a => a -> Doc ann
pretty (Int -> Text
pad Int
n) forall a. Semigroup a => a -> a -> a
<> Doc a
l)
forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => a -> Bool -> a
whenTrue
(forall x. One x => OneItem x -> x
one forall a b. (a -> b) -> a -> b
$
forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$
Int -> Text -> Text
Text.replicate (Text -> Int
Text.length (Int -> Text
pad Int
n) forall a. Num a => a -> a -> a
- Int
3) Text
" "
forall a. Semigroup a => a -> a -> a
<> Text
"|"
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate (Int
_begCol forall a. Num a => a -> a -> a
+ Int
1) Text
" "
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate (Int
_endCol forall a. Num a => a -> a -> a
- Int
_begCol) Text
"^"
)
(Int
begLine forall a. Eq a => a -> a -> Bool
== Int
endLine Bool -> Bool -> Bool
&& Int
n forall a. Eq a => a -> a -> Bool
== Int
endLine)
ls' :: [Doc a]
ls' = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Doc a -> [Doc a]
composeLine [Int
beg' ..] [Doc a]
ls
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep forall a b. (a -> b) -> a -> b
$ [Doc a]
ls' forall a. Semigroup a => a -> a -> a
<> forall x. One x => OneItem x -> x
one (forall ann. Int -> Doc ann -> Doc ann
indent (Text -> Int
Text.length forall a b. (a -> b) -> a -> b
$ Int -> Text
pad Int
begLine) Doc a
msg)