{-# LANGUAGE OverloadedStrings, RecordWildCards #-} -- | Pretty-printing of Bash scripts. This tries to stay close to the format -- used by the Bash builtin @declare -f@. module Language.Bash.Pretty ( Pretty(..) , render ) where import Text.PrettyPrint import Language.Bash.Syntax -- | A class of types which may be pretty-printed. class Pretty a where -- | Pretty-print to a 'Doc'. pretty :: a -> Doc -- | Pretty-print a list. By default, this separates each element with -- a space using 'hsep'. prettyList :: [a] -> Doc prettyList = hsep . map pretty instance Pretty a => Pretty [a] where pretty = prettyList instance Pretty Doc where pretty = id instance Pretty Char where pretty c = text [c] prettyList = text instance Pretty a => Pretty (Maybe a) where pretty = maybe empty pretty instance (Pretty a, Pretty b) => Pretty (Either a b) where pretty = either pretty pretty instance Pretty Command where pretty (Command c rs) = pretty c <+> pretty rs instance Pretty Redir where pretty Redir{..} = pretty redirDesc <> text redirOp <> text redirTarget pretty Heredoc{..} = text redirOp <> text (if heredocDelimQuoted then "'" ++ heredocDelim ++ "'" else heredocDelim) <> "\n" <> text document <> text heredocDelim <> "\n" prettyList = foldr f empty where f a@(Redir{}) b = pretty a <+> b f a@(Heredoc{}) b = pretty a <> b instance Pretty IODesc where pretty (IONumber n) = int n pretty (IOVar n) = "{" <> text n <> "}" instance Pretty ShellCommand where pretty (SimpleCommand as ws) = pretty as <+> pretty ws pretty (AssignBuiltin w args) = text w <+> pretty args pretty (FunctionDef name l) = text name <+> "()" $+$ pretty (Group l) pretty (Coproc name c) = "coproc" <+> text name <+> pretty c pretty (Subshell l) = "(" <+> pretty l <+> ")" pretty (Group l) = "{" $+$ indent l $+$ "}" pretty (Arith s) = "((" <> text s <> "))" pretty (Cond ws) = "[[" <+> pretty ws <+> "]]" pretty (For w ws l) = "for" <+> text w <+> "in" <+> pretty ws <> ";" $+$ doDone l pretty (ArithFor s l) = "for" <+> "((" <> text s <> "))" $+$ doDone l pretty (Select w ws l) = "select" <+> text w <+> "in" <+> pretty ws <> ";" $+$ doDone l pretty (Case w cs) = "case" <+> text w <+> "in" $+$ indent cs $+$ "esac" pretty (If p t f) = "if" <+> pretty p <+> "then" $+$ indent t $+$ pretty (fmap (\l -> "else" $+$ indent l) f) $+$ "fi" pretty (Until p l) = "until" <+> pretty p <+> doDone l pretty (While p l) = "while" <+> pretty p <+> doDone l instance Pretty CaseClause where pretty (CaseClause ps l term) = hcat (punctuate " | " (map text ps)) <> ")" $+$ indent l $+$ pretty term instance Pretty CaseTerm where pretty Break = ";;" pretty FallThrough = ";&" pretty Continue = ";;&" instance Pretty List where pretty (List as) = pretty as instance Pretty Statement where pretty (Statement l Sequential) = pretty l <> ";" pretty (Statement l Asynchronous) = pretty l <+> "&" prettyList = foldr f empty where f a@(Statement _ Sequential) b = pretty a $+$ b f a@(Statement _ Asynchronous) b = pretty a <+> b instance Pretty ListTerm where pretty Sequential = ";" pretty Asynchronous = "&" instance Pretty AndOr where pretty (Last p) = pretty p pretty (And p a) = pretty p <+> "&&" <+> pretty a pretty (Or p a) = pretty p <+> "||" <+> pretty a instance Pretty Pipeline where pretty Pipeline{..} = (if timed then "time" else empty) <+> (if timedPosix then "-p" else empty) <+> (if inverted then "!" else empty) <+> pretty commands instance Pretty Assign where pretty (Assign lhs op rhs) = pretty lhs <> pretty op <> pretty rhs instance Pretty LValue where pretty (LValue name sub) = text name <> pretty (fmap (\s -> "[" ++ s ++ "]") sub) instance Pretty AssignOp where pretty Equals = "=" pretty PlusEquals = "+=" instance Pretty RValue where pretty (RValue w) = text w pretty (RArray rs) = "(" <> hsep (map f rs) <> ")" where f (sub, w) = pretty (fmap (\s -> "[" ++ s ++ "]=") sub) <> text w -- | Indent by 4 columns. indent :: Pretty a => a -> Doc indent = nest 4 . pretty -- | Render a @do...done@ block. doDone :: Pretty a => a -> Doc doDone a = "do" $+$ indent a $+$ "done"