{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}

-- | This module provides the `Src` type used for source spans in error messages

module Dhall.Src
    ( -- * Type
      Src(..)
    ) where

import Control.DeepSeq            (NFData)
import Data.Data                  (Data)
import Data.Text                  (Text)
import GHC.Generics               (Generic)
import Instances.TH.Lift          ()
import Language.Haskell.TH.Syntax (Lift (..))
import Prettyprinter              (Pretty (..))
import Text.Megaparsec            (SourcePos (SourcePos), mkPos, unPos)

import {-# SOURCE #-} qualified Dhall.Util

import qualified Data.Text       as Text
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Printf     as Printf

-- | Source code extract
data Src = Src
    { Src -> SourcePos
srcStart :: !SourcePos
    , Src -> SourcePos
srcEnd   :: !SourcePos
    , Src -> Text
srcText  :: Text -- Text field is intentionally lazy
    } deriving (Typeable Src
Typeable Src =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Src -> c Src)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Src)
-> (Src -> Constr)
-> (Src -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Src))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Src))
-> ((forall b. Data b => b -> b) -> Src -> Src)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r)
-> (forall u. (forall d. Data d => d -> u) -> Src -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Src -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Src -> m Src)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Src -> m Src)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Src -> m Src)
-> Data Src
Src -> Constr
Src -> DataType
(forall b. Data b => b -> b) -> Src -> Src
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Src -> u
forall u. (forall d. Data d => d -> u) -> Src -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Src -> m Src
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Src -> m Src
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Src
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Src -> c Src
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Src)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Src)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Src -> c Src
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Src -> c Src
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Src
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Src
$ctoConstr :: Src -> Constr
toConstr :: Src -> Constr
$cdataTypeOf :: Src -> DataType
dataTypeOf :: Src -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Src)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Src)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Src)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Src)
$cgmapT :: (forall b. Data b => b -> b) -> Src -> Src
gmapT :: (forall b. Data b => b -> b) -> Src -> Src
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Src -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Src -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Src -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Src -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Src -> m Src
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Src -> m Src
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Src -> m Src
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Src -> m Src
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Src -> m Src
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Src -> m Src
Data, Src -> Src -> Bool
(Src -> Src -> Bool) -> (Src -> Src -> Bool) -> Eq Src
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Src -> Src -> Bool
== :: Src -> Src -> Bool
$c/= :: Src -> Src -> Bool
/= :: Src -> Src -> Bool
Eq, (forall x. Src -> Rep Src x)
-> (forall x. Rep Src x -> Src) -> Generic Src
forall x. Rep Src x -> Src
forall x. Src -> Rep Src x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Src -> Rep Src x
from :: forall x. Src -> Rep Src x
$cto :: forall x. Rep Src x -> Src
to :: forall x. Rep Src x -> Src
Generic, Eq Src
Eq Src =>
(Src -> Src -> Ordering)
-> (Src -> Src -> Bool)
-> (Src -> Src -> Bool)
-> (Src -> Src -> Bool)
-> (Src -> Src -> Bool)
-> (Src -> Src -> Src)
-> (Src -> Src -> Src)
-> Ord Src
Src -> Src -> Bool
Src -> Src -> Ordering
Src -> Src -> Src
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Src -> Src -> Ordering
compare :: Src -> Src -> Ordering
$c< :: Src -> Src -> Bool
< :: Src -> Src -> Bool
$c<= :: Src -> Src -> Bool
<= :: Src -> Src -> Bool
$c> :: Src -> Src -> Bool
> :: Src -> Src -> Bool
$c>= :: Src -> Src -> Bool
>= :: Src -> Src -> Bool
$cmax :: Src -> Src -> Src
max :: Src -> Src -> Src
$cmin :: Src -> Src -> Src
min :: Src -> Src -> Src
Ord, Int -> Src -> ShowS
[Src] -> ShowS
Src -> String
(Int -> Src -> ShowS)
-> (Src -> String) -> ([Src] -> ShowS) -> Show Src
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Src -> ShowS
showsPrec :: Int -> Src -> ShowS
$cshow :: Src -> String
show :: Src -> String
$cshowList :: [Src] -> ShowS
showList :: [Src] -> ShowS
Show, Src -> ()
(Src -> ()) -> NFData Src
forall a. (a -> ()) -> NFData a
$crnf :: Src -> ()
rnf :: Src -> ()
NFData)


instance Lift Src where
#if MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: forall (m :: * -> *). Quote m => Src -> Code m Src
liftTyped (Src (SourcePos String
a Pos
b Pos
c) (SourcePos String
d Pos
e Pos
f) Text
g) =
        [|| SourcePos -> SourcePos -> Text -> Src
Src (String -> Pos -> Pos -> SourcePos
SourcePos String
a (Int -> Pos
mkPos Int
b') (Int -> Pos
mkPos Int
c')) (String -> Pos -> Pos -> SourcePos
SourcePos String
d (Int -> Pos
mkPos Int
e') (Int -> Pos
mkPos Int
f')) Text
g ||]
#else
    lift (Src (SourcePos a b c) (SourcePos d e f) g) =
        [| Src (SourcePos a (mkPos b') (mkPos c')) (SourcePos d (mkPos e') (mkPos f')) g |]
#endif
      where
        b' :: Int
b' = Pos -> Int
unPos Pos
b
        c' :: Int
c' = Pos -> Int
unPos Pos
c
        e' :: Int
e' = Pos -> Int
unPos Pos
e
        f' :: Int
f' = Pos -> Int
unPos Pos
f


instance Pretty Src where
    pretty :: forall ann. Src -> Doc ann
pretty (Src SourcePos
begin SourcePos
_ Text
text) =
            Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Text
Dhall.Util.snip Text
numberedLines)
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
"\n"
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (SourcePos -> String
Megaparsec.sourcePosPretty SourcePos
begin)
      where
        prefix :: Text
prefix = Int -> Text -> Text
Text.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
" "
          where
            n :: Int
n = Pos -> Int
Megaparsec.unPos (SourcePos -> Pos
Megaparsec.sourceColumn SourcePos
begin)

        ls :: [Text]
ls = Text -> [Text]
Text.lines (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text)

        numberOfLines :: Int
numberOfLines = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls

        minimumNumber :: Int
minimumNumber =
            Pos -> Int
Megaparsec.unPos (SourcePos -> Pos
Megaparsec.sourceLine SourcePos
begin)

        maximumNumber :: Int
maximumNumber = Int
minimumNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numberOfLines Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

        numberWidth :: Int
        numberWidth :: Int
numberWidth =
            Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Double
10 :: Double) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maximumNumber)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        adapt :: p -> Text -> Text
adapt p
n Text
line = String -> Text
Text.pack String
outputString
          where
            inputString :: String
inputString = Text -> String
Text.unpack Text
line

            outputString :: String
outputString =
                String -> p -> ShowS
forall r. PrintfType r => String -> r
Printf.printf (String
"%" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
numberWidth String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"d│ %s") p
n String
inputString

        numberedLines :: Text
numberedLines = [Text] -> Text
Text.unlines ((Int -> Text -> Text) -> [Int] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> Text
forall {p}. PrintfArg p => p -> Text -> Text
adapt [Int
minimumNumber..] [Text]
ls)