src/hzsff.hs

   1 --
   2 -- hzsff, a program to do things to ZSFF files.
   3 -- See http://www.zedshaw.com/blog/2008-01-13.html.
   4 --
   5 -- Copyright Michael Orlitzky
   6 --
   7 -- http://michael.orlitzky.com/
   8 --
   9 -- This program is free software: you can redistribute it and/or modify
  10 -- it under the terms of the GNU General Public License as published by
  11 -- the Free Software Foundation, either version 3 of the License, or
  12 -- (at your option) any later version.
  13 --
  14 -- This program is distributed in the hope that it will be useful,
  15 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  17 -- GNU General Public License for more details.
  18 --
  19 -- http://www.fsf.org/licensing/licenses/gpl.html
  20
  21 import System.Environment (getArgs)
  22 import System.Exit
  23 import Text.ParserCombinators.Parsec
  24
  25
  26 data Version = Version (String)
  27              deriving (Show)
  28
  29 data Header = Header (String, String)
  30             deriving (Show)
  31
  32 data Url = Url (String)
  33          deriving (Show)
  34
  35 data ZsffFeed = ZsffFeed (Version, [Header], [Url])
  36                 deriving (Show)
  37
  38
  39 version_characters :: GenParser Char st Char
  40 version_characters = digit <|>
  41                      char '.'
  42
  43 version_parser :: Parser Version
  44 version_parser = do
  45   string "ZSFF "
  46   val <- many1 version_characters
  47   char '\n'
  48   return $ Version (val)
  49
  50
  51 header_characters :: GenParser Char st Char
  52 header_characters = alphaNum <|>
  53                     char '-'
  54
  55
  56 header_parser :: Parser Header
  57 header_parser = do
  58   val1 <- many1 header_characters
  59   char ':'
  60   skipMany space
  61   val2 <- manyTill anyChar (char '\n')
  62   return $ Header (val1, val2)
  63
  64
  65 headers_parser :: Parser [Header]
  66 headers_parser = do
  67   headers <- many1 header_parser
  68   return headers
  69
  70
  71 -- Ad-hoc compilation of characters that I think
  72 -- are valid in URLs
  73 url_characters :: GenParser Char st Char
  74 url_characters = alphaNum <|>
  75                  char '.' <|>
  76                  char ':' <|>
  77                  char '_' <|>
  78                  char '-' <|>
  79                  char '%' <|>
  80                  char '~' <|>
  81                  char '?' <|>
  82                  char '/' <|>
  83                  char '#' <|>
  84                  char '&' <|>
  85                  char '+'
  86
  87
  88 -- Will parse one or more url_characters
  89 url_parser :: Parser Url
  90 url_parser = do
  91   val <- manyTill url_characters (char '\n')
  92   return $ Url (val)
  93
  94
  95 urls_parser :: Parser [Url]
  96 urls_parser = do
  97   urls <- many1 url_parser
  98   return urls
  99
 100
 101 main_parser :: Parser ZsffFeed
 102 main_parser = do
 103   version <- version_parser
 104   headers <- headers_parser
 105   char '\n'
 106   urls <- urls_parser
 107   return $ ZsffFeed (version, headers, urls)
 108
 109
 110 main = do
 111   args <- getArgs
 112   feed <- readFile (args !! 0)
 113   case (parse main_parser "" feed) of
 114     Left err -> do
 115          putStrLn ("Error " ++ (show err))
 116          exitFailure
 117     Right ast -> do
 118          putStrLn (show ast)
 119          exitWith ExitSuccess
 120