{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Dhall.Src
(
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
data Src = Src
{ Src -> SourcePos
srcStart :: !SourcePos
, Src -> SourcePos
srcEnd :: !SourcePos
, Src -> Text
srcText :: Text
} 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)