]> gitweb.michael.orlitzky.com - dead/hzsff.git/commitdiff
Initial commit. master
authorMichael Orlitzky <michael@orlitzky.com>
Tue, 18 Aug 2009 20:00:54 +0000 (16:00 -0400)
committerMichael Orlitzky <michael@orlitzky.com>
Tue, 18 Aug 2009 20:00:54 +0000 (16:00 -0400)
makefile [new file with mode: 0644]
src/hzsff.hs [new file with mode: 0644]
test/feed-2008-01-16.zsff [new file with mode: 0644]

diff --git a/makefile b/makefile
new file mode 100644 (file)
index 0000000..ab7af2f
--- /dev/null
+++ b/makefile
@@ -0,0 +1,9 @@
+all: hzsff
+
+hzsff: src/*.hs
+       ghc --make -O3 -o bin/hzsff src/*.hs
+
+clean:
+       rm -f bin/hzsff
+       rm -f src/*.hi
+       rm -f src/*.o
diff --git a/src/hzsff.hs b/src/hzsff.hs
new file mode 100644 (file)
index 0000000..24e8a84
--- /dev/null
@@ -0,0 +1,120 @@
+--
+-- 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
diff --git a/test/feed-2008-01-16.zsff b/test/feed-2008-01-16.zsff
new file mode 100644 (file)
index 0000000..ff34fa1
--- /dev/null
@@ -0,0 +1,48 @@
+ZSFF 1.0
+Author: Zed A. Shaw
+Title: Zed's So Fucking Awesome
+Site: http://www.zedshaw.com/
+Subtitle: Yes, that's a left handed guitar.
+Copyright: 2002-2008
+Content-type: text/plain
+
+http://www.zedshaw.com/blog/2006-08-17.html
+http://www.zedshaw.com/blog/2006-08-17.page
+http://www.zedshaw.com/blog/2006-12-19.html
+http://www.zedshaw.com/blog/2006-12-19.page
+http://www.zedshaw.com/blog/2006-12-25.html
+http://www.zedshaw.com/blog/2006-12-25.page
+http://www.zedshaw.com/blog/2006-12-26.html
+http://www.zedshaw.com/blog/2006-12-26.page
+http://www.zedshaw.com/blog/2007-12-25.html
+http://www.zedshaw.com/blog/2007-12-25.page
+http://www.zedshaw.com/blog/2007-12-26.html
+http://www.zedshaw.com/blog/2007-12-26.page
+http://www.zedshaw.com/blog/2007-12-27.html
+http://www.zedshaw.com/blog/2007-12-27.page
+http://www.zedshaw.com/blog/2007-12-28.html
+http://www.zedshaw.com/blog/2007-12-28.page
+http://www.zedshaw.com/blog/2007-12-29.html
+http://www.zedshaw.com/blog/2007-12-29.page
+http://www.zedshaw.com/blog/2007-12-31.html
+http://www.zedshaw.com/blog/2007-12-31.page
+http://www.zedshaw.com/blog/2008-01-01.html
+http://www.zedshaw.com/blog/2008-01-01.page
+http://www.zedshaw.com/blog/2008-01-02.html
+http://www.zedshaw.com/blog/2008-01-02.page
+http://www.zedshaw.com/blog/2008-01-03.html
+http://www.zedshaw.com/blog/2008-01-03.page
+http://www.zedshaw.com/blog/2008-01-04.html
+http://www.zedshaw.com/blog/2008-01-04.page
+http://www.zedshaw.com/blog/2008-01-06.html
+http://www.zedshaw.com/blog/2008-01-06.page
+http://www.zedshaw.com/blog/2008-01-08.html
+http://www.zedshaw.com/blog/2008-01-08.page
+http://www.zedshaw.com/blog/2008-01-09.html
+http://www.zedshaw.com/blog/2008-01-09.page
+http://www.zedshaw.com/blog/2008-01-10.html
+http://www.zedshaw.com/blog/2008-01-10.page
+http://www.zedshaw.com/blog/2008-01-13.html
+http://www.zedshaw.com/blog/2008-01-13.page
+http://www.zedshaw.com/blog/2008-01-14.html
+http://www.zedshaw.com/blog/2008-01-14.page