{-# 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 = 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
"]"