{-# 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
DataType
Constr
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 -> DataType
Src -> Constr
(forall b. Data b => b -> b) -> Src -> Src
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Src -> c Src
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSrc :: Constr
$tSrc :: DataType
gmapMo :: (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
gmapMp :: (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
gmapM :: (forall d. Data d => d -> m d) -> Src -> m Src
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Src -> m Src
gmapQi :: Int -> (forall d. Data d => d -> u) -> Src -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Src -> u
gmapQ :: (forall d. Data d => d -> u) -> Src -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Src -> [u]
gmapQr :: (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
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Src -> r
gmapT :: (forall b. Data b => b -> b) -> Src -> Src
$cgmapT :: (forall b. Data b => b -> b) -> Src -> Src
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Src)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Src)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Src)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Src)
dataTypeOf :: Src -> DataType
$cdataTypeOf :: Src -> DataType
toConstr :: Src -> Constr
$ctoConstr :: Src -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Src
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Src
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Src -> c Src
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Src -> c Src
$cp1Data :: Typeable Src
Data, Src -> Src -> Bool
(Src -> Src -> Bool) -> (Src -> Src -> Bool) -> Eq Src
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Src -> Src -> Bool
$c/= :: Src -> Src -> Bool
== :: Src -> Src -> Bool
$c== :: 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
$cto :: forall x. Rep Src x -> Src
$cfrom :: forall x. Src -> Rep Src x
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
min :: Src -> Src -> Src
$cmin :: Src -> Src -> Src
max :: Src -> Src -> Src
$cmax :: Src -> Src -> Src
>= :: Src -> Src -> Bool
$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
compare :: Src -> Src -> Ordering
$ccompare :: Src -> Src -> Ordering
$cp1Ord :: Eq 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
showList :: [Src] -> ShowS
$cshowList :: [Src] -> ShowS
show :: Src -> String
$cshow :: Src -> String
showsPrec :: Int -> Src -> ShowS
$cshowsPrec :: Int -> Src -> ShowS
Show, Src -> ()
(Src -> ()) -> NFData Src
forall a. (a -> ()) -> NFData a
rnf :: Src -> ()
$crnf :: Src -> ()
NFData)


instance Lift Src where
#if MIN_VERSION_template_haskell(2,16,0)
    liftTyped :: Src -> Q (TExp Src)
liftTyped (Src (SourcePos String
a Pos
b Pos
c) (SourcePos String
d Pos
e Pos
f) Text
g) =
        [|| Src (SourcePos a (mkPos b') (mkPos c')) (SourcePos d (mkPos e') (mkPos f')) 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 :: Src -> Doc ann
pretty (Src SourcePos
begin SourcePos
_ Text
text) =
            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 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 (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 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)