{-# LANGUAGE CPP, FlexibleInstances, TemplateHaskell #-}
{-# OPTIONS -Wall #-}
module Debian.TH
( here
, Loc
) where
import Data.List (intersperse)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid ((<>))
#endif
import Distribution.Pretty (Pretty(..))
import Language.Haskell.TH (ExpQ, Loc(..), location)
import Language.Haskell.TH.Instances ()
import Language.Haskell.TH.Lift (lift)
import Text.PrettyPrint.HughesPJClass (Doc, hcat, text)
here :: ExpQ
here :: ExpQ
here = Loc -> ExpQ
forall t. Lift t => t -> ExpQ
lift (Loc -> ExpQ) -> Q Loc -> ExpQ
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Q Loc
location
instance Pretty Loc where
pretty :: Loc -> Doc
pretty = Loc -> Doc
prettyLoc
prettyLoc :: Loc -> Doc
prettyLoc :: Loc -> Doc
prettyLoc (Loc String
_filename String
_package String
modul (Int
line, Int
col) (Int, Int)
_) = String -> Doc
text (String
modul String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col)
instance Pretty [Loc] where
pretty :: [Loc] -> Doc
pretty [Loc]
locs = String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (String -> Doc
text String
" → ") ((Loc -> Doc) -> [Loc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Loc -> Doc
prettyLoc [Loc]
locs)) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"