{-# 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)
        -- XXX: Consider inserting the message here when it is small enough.
        -- ATM some messages are so huge that they take prevalence over the source listing.
        -- ++ [ indent (length $ pad n) msg | n == 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)