{-# 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 (Doc, text)
import Text.PrettyPrint.HughesPJClass (Doc, hcat, text)

here :: ExpQ
here :: ExpQ
here = forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
lift 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 [Char]
_filename [Char]
_package [Char]
modul (Int
line, Int
col) (Int, Int)
_) = [Char] -> Doc
text ([Char]
modul forall a. Semigroup a => a -> a -> a
<> [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
line forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
col)

instance Pretty [Loc] where
    pretty :: [Loc] -> Doc
pretty [Loc]
locs = [Char] -> Doc
text [Char]
"[" forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
hcat (forall a. a -> [a] -> [a]
intersperse ([Char] -> Doc
text [Char]
" → ") (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Loc -> Doc
prettyLoc [Loc]
locs)) forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"]"