module Distribution.Pretty (
    Pretty (..),
    prettyShow,
    defaultStyle,
    flatStyle,
    
    showFilePath,
    showToken,
    showFreeText,
    showFreeTextV3,
    
    Separator,
    ) where
import Distribution.CabalSpecVersion
import Distribution.Compat.Prelude
import Prelude ()
import qualified Text.PrettyPrint as PP
class Pretty a where
    pretty :: a -> PP.Doc
    prettyVersioned :: CabalSpecVersion -> a -> PP.Doc
    prettyVersioned _ = pretty
instance Pretty Bool where
    pretty = PP.text . show
instance Pretty Int where
    pretty = PP.text . show
instance Pretty a => Pretty (Identity a) where
    pretty = pretty . runIdentity
prettyShow :: Pretty a => a -> String
prettyShow = PP.renderStyle defaultStyle . pretty
defaultStyle :: PP.Style
defaultStyle = PP.Style { PP.mode           = PP.PageMode
                          , PP.lineLength     = 79
                          , PP.ribbonsPerLine = 1.0
                          }
flatStyle :: PP.Style
flatStyle = PP.Style { PP.mode = PP.LeftMode
                       , PP.lineLength = err "lineLength"
                       , PP.ribbonsPerLine = err "ribbonsPerLine"
                       }
  where
    err x = error ("flatStyle: tried to access " ++ x ++ " in LeftMode. " ++
                   "This should never happen and indicates a bug in Cabal.")
type Separator = [PP.Doc] -> PP.Doc
showFilePath :: FilePath -> PP.Doc
showFilePath = showToken
showToken :: String -> PP.Doc
showToken str
    
    | "--" `isPrefixOf` str                 = PP.text (show str)
    
    | ":" `isSuffixOf` str                  = PP.text (show str)
    | not (any dodgy str) && not (null str) = PP.text str
    | otherwise                             = PP.text (show str)
  where
    dodgy c = isSpace c || c == ','
showFreeText :: String -> PP.Doc
showFreeText "" = mempty
showFreeText s  = PP.vcat [ PP.text (if null l then "." else l) | l <- lines_ s ]
showFreeTextV3 :: String -> PP.Doc
showFreeTextV3 "" = mempty
showFreeTextV3 s  = PP.vcat [ PP.text l | l <- lines_ s ]
lines_                   :: String -> [String]
lines_ [] = [""]
lines_ s  =
    let (l, s') = break (== '\n') s
    in  l : case s' of
        []      -> []
        (_:s'') -> lines_ s''