{-# 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
Src -> DataType
Src -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Src -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Src -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Src -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Src -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, Src -> Src -> Bool
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. 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
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
Ord, Int -> Src -> ShowS
[Src] -> ShowS
Src -> String
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: Src -> ()
$crnf :: 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) =
        [|| 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 :: forall ann. Src -> Doc ann
pretty (Src SourcePos
begin SourcePos
_ Text
text) =
            forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Text
Dhall.Util.snip Text
numberedLines)
        forall a. Semigroup a => a -> a -> a
<>  Doc ann
"\n"
        forall a. Semigroup a => a -> a -> a
<>  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 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 forall a. Semigroup a => a -> a -> a
<> Text
text)

        numberOfLines :: Int
numberOfLines = 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 forall a. Num a => a -> a -> a
+ Int
numberOfLines forall a. Num a => a -> a -> a
- Int
1

        numberWidth :: Int
        numberWidth :: Int
numberWidth =
            forall a b. (RealFrac a, Integral b) => a -> b
truncate (forall a. Floating a => a -> a -> a
logBase (Double
10 :: Double) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maximumNumber)) 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 =
                forall r. PrintfType r => String -> r
Printf.printf (String
"%" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
numberWidth forall a. Semigroup a => a -> a -> a
<> String
"d│ %s") p
n String
inputString

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