module Lighttpd.Conf.Ppr (
Ppr(..)
, pprField
, PprMode(..)
, pprWithMode
, module Text.PrettyPrint.HughesPJ
) where
import Lighttpd.Conf.Syntax
import Text.PrettyPrint.HughesPJ
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
class Ppr a where
ppr :: a -> Doc
pprs :: [a] -> Doc
pprs = vcat . fmap ppr
data PprMode
= Compact
| Spaced
deriving (Eq,Ord,Show,Read)
pprWithMode :: PprMode -> Config -> Doc
pprWithMode Compact c = ppr c
pprWithMode Spaced (Config es) =
vcat . punctuate (text "\n")
. fmap ppr $ es
instance Ppr Config where
ppr (Config es) = vcat . fmap ppr $ es
instance Ppr String where ppr = dQText
instance Ppr ByteString where ppr = dQText . B.unpack
instance Ppr Int where ppr = int
instance Ppr Name where
ppr (Name a) = text (B.unpack a)
instance Ppr QName where
ppr (QName a b) = ppr a <> dot <> ppr b
instance Ppr Exp where
ppr (CommentE s) = text "#" <> text (B.unpack s)
ppr (GlobalCxtE es) = text "global" <+> text "{"
$+$ nest 2 (pprs es)
$+$ text "}"
ppr (OptionE qn v) = ppr qn <+> text "=" <+> ppr v
ppr (MergeE qn v) = ppr qn <+> text "+=" <+> ppr v
ppr (IncludeE i) = ppr i
ppr (CondE c es elses) = ppr c <+> text "{"
$+$ nest 2 (pprs es)
$+$ text "}"
$+$ pprs elses
instance Ppr CondElse where
ppr (CondElse c es) = text "else"
<+> ppr c <+> text "{"
$+$ nest 2 (pprs es)
$+$ text "}"
instance Ppr Val where
ppr (VarV qn) = ppr qn
ppr (StringV a) = ppr a
ppr (IntegerV a) = ppr a
ppr (BooleanV a) = ppr a
ppr (SpliceV a) =
text "$" <>
text (B.unpack a)
ppr (ArrayV es) =
parens . vcat
. punctuate comma
. fmap ppr $ es
ppr (ManyV vs) =
foldr (<+>) empty
. punctuate (space<>plus)
. fmap ppr $ vs
instance Ppr Enabled where
ppr Enable = dQText "enable"
ppr Disable = dQText "disable"
instance Ppr ArrayElem where
ppr (ArrayElem Nothing v) = ppr v
ppr (ArrayElem (Just n) v) = doubleQuotes (ppr n)
<+> text "=>"
<+> ppr v
instance Ppr Include where
ppr (ValueI v) = text "include" <+> ppr v
ppr (ShellI s) = text "include_shell" <+> ppr s
instance Ppr Cond where
ppr (Cond f op p) = ppr f <+> ppr op <+> ppr p
instance Ppr Op where
ppr Equal = text "=="
ppr NotEqual = text "!="
ppr Match = text "=~"
ppr NotMatch = text "!~"
instance Ppr Pat where
ppr (StringP s) = ppr s
ppr (RegexP s) = ppr s
instance Ppr Field where
ppr (Field n v) = pprField (ppr n) (ppr v)
pprField :: Doc -> Doc -> Doc
pprField n v = text "$" <> n <> brackets v
dQText :: String -> Doc
dQText = doubleQuotes . text
dot = text "."
plus = text "+"
chunk :: Int -> [a] -> [[a]]
chunk = (takeWhile (not . null) .) . go . splitAt
where go f xs = let (y,ys) = f xs in y : go f ys