{-# 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.Monoid ((<>))
import Data.Text (Text)
import Data.Text.Prettyprint.Doc  (Pretty (..))
import GHC.Generics (Generic)
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift(..))
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)