+--
+-- hzsff, a program to do things to ZSFF files.
+-- See http://www.zedshaw.com/blog/2008-01-13.html.
+--
+-- Copyright Michael Orlitzky
+--
+-- http://michael.orlitzky.com/
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- http://www.fsf.org/licensing/licenses/gpl.html
+
+import System.Environment (getArgs)
+import System.Exit
+import Text.ParserCombinators.Parsec
+
+
+data Version = Version (String)
+ deriving (Show)
+
+data Header = Header (String, String)
+ deriving (Show)
+
+data Url = Url (String)
+ deriving (Show)
+
+data ZsffFeed = ZsffFeed (Version, [Header], [Url])
+ deriving (Show)
+
+
+version_characters :: GenParser Char st Char
+version_characters = digit <|>
+ char '.'
+
+version_parser :: Parser Version
+version_parser = do
+ string "ZSFF "
+ val <- many1 version_characters
+ char '\n'
+ return $ Version (val)
+
+
+header_characters :: GenParser Char st Char
+header_characters = alphaNum <|>
+ char '-'
+
+
+header_parser :: Parser Header
+header_parser = do
+ val1 <- many1 header_characters
+ char ':'
+ skipMany space
+ val2 <- manyTill anyChar (char '\n')
+ return $ Header (val1, val2)
+
+
+headers_parser :: Parser [Header]
+headers_parser = do
+ headers <- many1 header_parser
+ return headers
+
+
+-- Ad-hoc compilation of characters that I think
+-- are valid in URLs
+url_characters :: GenParser Char st Char
+url_characters = alphaNum <|>
+ char '.' <|>
+ char ':' <|>
+ char '_' <|>
+ char '-' <|>
+ char '%' <|>
+ char '~' <|>
+ char '?' <|>
+ char '/' <|>
+ char '#' <|>
+ char '&' <|>
+ char '+'
+
+
+-- Will parse one or more url_characters
+url_parser :: Parser Url
+url_parser = do
+ val <- manyTill url_characters (char '\n')
+ return $ Url (val)
+
+
+urls_parser :: Parser [Url]
+urls_parser = do
+ urls <- many1 url_parser
+ return urls
+
+
+main_parser :: Parser ZsffFeed
+main_parser = do
+ version <- version_parser
+ headers <- headers_parser
+ char '\n'
+ urls <- urls_parser
+ return $ ZsffFeed (version, headers, urls)
+
+
+main = do
+ args <- getArgs
+ feed <- readFile (args !! 0)
+ case (parse main_parser "" feed) of
+ Left err -> do
+ putStrLn ("Error " ++ (show err))
+ exitFailure
+ Right ast -> do
+ putStrLn (show ast)
+ exitWith ExitSuccess
+
\ No newline at end of file
projects / dead / hzsff.git / commitdiff