module Debian.Control.String
(
Control'(..)
, Paragraph'(..)
, Field'(..)
, Control
, Paragraph
, Field
, ControlParser
, ControlFunctions(..)
, pControl
, mergeControls
, fieldValue
, removeField
, prependFields
, appendFields
, renameField
, modifyField
, raiseFields
) where
import qualified Control.Exception as E
import Data.Char (toLower)
import Data.List
import Text.ParserCombinators.Parsec
import System.IO
import Debian.Control.Common
import Text.PrettyPrint.ANSI.Leijen (Pretty(pretty), text, vcat, (<$>), empty)
instance Pretty (Control' String) where
pretty (Control paragraphs) = vcat (map (\ p -> pretty p) paragraphs)
instance Pretty (Paragraph' String) where
pretty (Paragraph fields) = vcat (map pretty fields ++ [empty])
instance Pretty (Field' String) where
pretty (Field (name,value)) = text $ name ++":"++ value
pretty (Comment s) = text s
type Field = Field' String
type Control = Control' String
type Paragraph = Paragraph' String
instance ControlFunctions String where
parseControlFromFile filepath =
parseFromFile pControl filepath
parseControlFromHandle sourceName handle =
E.try (hGetContents handle) >>=
either (\ (e :: E.SomeException) -> error ("parseControlFromHandle String: Failure parsing " ++ sourceName ++ ": " ++ show e)) (return . parseControl sourceName)
parseControl sourceName c =
parse pControl sourceName c
lookupP fieldName (Paragraph paragraph) =
find (hasFieldName (map toLower fieldName)) paragraph
where hasFieldName name (Field (fieldName',_)) = name == map toLower fieldName'
hasFieldName _ _ = False
stripWS = reverse . strip . reverse . strip
where strip = dropWhile (flip elem " \t")
asString = id
type ControlParser a = CharParser () a
pControl :: ControlParser Control
pControl =
do many $ char '\n'
sepEndBy pParagraph pBlanks >>= return . Control
pParagraph :: ControlParser Paragraph
pParagraph = many1 (pComment <|> pField) >>= return . Paragraph
pField :: ControlParser Field
pField =
do c1 <- noneOf "#\n"
fieldName <- many1 $ noneOf ":\n"
char ':'
fieldValue <- many fcharfws
(char '\n' >> return ()) <|> eof
return $ Field (c1 : fieldName, fieldValue)
pComment :: ControlParser Field
pComment =
do char '#'
text <- many (satisfy (not . ((==) '\n')))
char '\n'
return $ Comment ("#" ++ text ++ "\n")
fcharfws :: ControlParser Char
fcharfws = fchar <|> (try $ lookAhead (string "\n ") >> char '\n') <|> (try $ lookAhead (string "\n\t") >> char '\n') <|> (try $ lookAhead (string "\n#") >> char '\n')
fchar :: ControlParser Char
fchar = satisfy (/='\n')
_fws :: ControlParser String
_fws =
try $ do char '\n'
ws <- many1 (char ' ')
c <- many1 (satisfy (not . ((==) '\n')))
return $ '\n' : (ws ++ c)
pBlanks :: ControlParser String
pBlanks = many1 (oneOf " \n")