packages feed

augur (empty) → 2008.10.19

raw patch · 12 files changed

+712/−0 lines, 12 filesdep +HaXmldep +basedep +bytestringsetup-changed

Dependencies added: HaXml, base, bytestring, classify, containers, directory, filepath, mtl, process

Files

+ LICENSE view
@@ -0,0 +1,35 @@+Copyright (c) 2004-2006, David Himmelstrup+All rights reserved.++Redistribution and use in source and binary forms,+with or without modification, are permitted provided+that the following conditions are met:++    * Redistributions of source code must retain+      the above copyright notice, this list of+      conditions and the following disclaimer.+    * Redistributions in binary form must reproduce+      the above copyright notice, this list of+      conditions and the following disclaimer in the+      documentation and/or other materials provided+      with the distribution.+    * Neither the name of David Himmelstrup nor the+      names of other contributors may be used to+      endorse or promote products derived from this+      software without specific prior written permission.+++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND+CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY+OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ augur.cabal view
@@ -0,0 +1,26 @@+Name:           augur+Version:        2008.10.19+Copyright:      2008, Lemmih+Build-Depends:  base, filepath, directory, bytestring, HaXml,+                containers, mtl, process, classify+Build-Type:     Simple+License:        BSD3+License-File:   LICENSE+Author:         Lemmih <lemmih@gmail.com>+Maintainer:     Lemmih <lemmih@gmail.com>+Synopsis:       Program for renaming media files.+Description:    Augur is a tool for parsing and renaming TV episodes. Examples:+                @+                  The.4400.S04E02.DSR.XviD-ORENJi.avi+                   -> The 4400 - 4x02 - Fear Itself.avi+                  24.S06E01.6AM.TO.7AM.PROPER.DVDRip.XviD-MEMETiC.avi+                   -> 24 - 6x01 - Day 6: 6:00 AM - 7:00 AM.avi+                @+                The pretty printing format is configurable with the default being @%S - %sx%2e - %E.%l@.+Category:       Tool+++Executable:     augur+Main-is:        Main.hs+Other-Modules:  Config, Epguide, Parse, Rename, Setup, Storage, Types, Utils+Hs-Source-Dirs: src
+ src/Config.hs view
@@ -0,0 +1,33 @@+module Config where++defaultFormat = "%S - %sx%2e - %E.%l"++data Config+    = Config+    { confVerbose  :: Int+    , confWGetPath :: String+    , confCurlPath :: String+    , confTidyPath :: String+    , confDryRun   :: Bool+    } deriving Show++data Action+    = Parse  { parseFormat :: String }+    | Rename { parseFormat :: String }+    | Inform { fromFiles :: [(String,FilePath)] }        -- Gather meta information.+    | Add+    | Remove+      deriving Show++data Flag+    = HelpFlag+    | Verbose Int+    | WGetPath String+    | TidyPath String+    | DryRun Bool+      -- For Parse+    | ParseFormat String+      -- For Inform+    | FromFile (String,FilePath)+      deriving Show+
+ src/Epguide.hs view
@@ -0,0 +1,93 @@+-- Programmatic interface to epguides.com information.+module Epguide+    ( fetchTitles+    , fetchTitlesFromFile+    , fetchTitles'+    ) where++import Utils+import Types+import Config++import Data.Char+import Data.List+import Data.Maybe+import Text.XML.HaXml+import Text.XML.HaXml.Xtract.Parse+import Control.Exception+import Control.Monad++import qualified Data.ByteString.Char8 as BS+import Text.ParserCombinators.ReadP++fetchTitles :: Config -> String -- ^Series+            -> IO [(LocalEpisodeIndex,String)]+fetchTitles cfg series+    = do let url = mkGoogleUrl "epguides.com" series+         mbDoc <- try $ downloadAsXML cfg url+         case mbDoc of+           Left _err -> return []+           Right doc -> fetchTitles' doc++fetchTitlesFromFile :: Config -> FilePath+                    -> IO [(LocalEpisodeIndex,String)]+fetchTitlesFromFile cfg inp+    = do html <- BS.readFile inp+         xml <- htmlToXml cfg html+         fetchTitles' (xmlParse inp (BS.unpack xml))++fetchTitles' :: Document -- ^ Input+             -> IO [(LocalEpisodeIndex,String)]+fetchTitles' (Document _ _ (Elem _ _ cs) _)+    = do let cs' = concatMap (xtract "//pre") cs+             titles = [ (index,title) | CElem (Elem "pre" _ cs'') <- cs'+                      , [CString _ l, CElem (Elem "a" attrs titleParts)] <- split 2 cs''+                      -- FIXME: support escape codes like &aacute+                      , let title = concat [ t | CString _ t <- titleParts ]+                      , index <- parseEpNum l+                      , Just (AttValue [Left str]) <- [lookup "href" attrs]+                      , "summary.html" `isSuffixOf` str+                      , not ("http://www.tv.com/show/" `isPrefixOf` str)+                      , title `notElem` ["TBD","TBA","TBW"]]+         return titles++parseEpNum :: String -> [LocalEpisodeIndex]+parseEpNum inp = fromMaybe [] $ flip fromReadP inp $+    do many anyChar+       satisfy (not.isDigit)+       s <- fmap read $ many1 digit+       char '-'+       skipSpaces+       e <- fmap read $ many1 digit+       satisfy (not.isDigit)+       guard (s > 0 && e > 0)+       many anyChar+       satisfy (not.isDigit)+       day <- fmap read $ many1 digit+       skipSpaces+       month <- getMonth+       skipSpaces+       year <- fmap read $ many1 digit+       return [EpIdx s e, DateIdx (year+2000) month day]++getMonth = choice $ map (\(n,str) -> string str >> return n) $ zip [1..]+           [ "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ]++digit :: ReadP Char+digit = satisfy isDigit++anyChar :: ReadP Char+anyChar = satisfy (const True)++fromReadP :: ReadP a -> String -> Maybe a+fromReadP p inp+    = case map fst $ readP_to_S p inp of+        [] -> Nothing+        lst -> Just (last lst)++split n lst+    = worker n [] lst+    where worker 0 acc lst = reverse acc:worker n [] lst+          worker _ acc [] = [reverse acc]+          worker n acc (x:xs) = worker (n-1) (x:acc) xs+
+ src/Main.hs view
@@ -0,0 +1,31 @@+module Main where++import System.Environment++import Control.Monad++import Storage+import Parse+import Rename+import Setup+import Config++{-++ add+ remove+ fetch+ parse+ rename++-}+++main :: IO ()+main = do (action, args, conf) <- parseArguments =<< getArgs+          case action of+            Add    -> forM_ args addSerie+            Remove -> forM_ args removeSerie+            Parse format -> do ppArgs <- parse conf format args+                               forM_ ppArgs putStrLn+            Rename format -> rename conf format args
+ src/Parse.hs view
@@ -0,0 +1,36 @@+module Parse where++import Types+import Config+import Storage++import Data.Classify.Rank+import Data.Classify.Parser+import Data.Classify.Printer+import Data.Classify.DataTypes++import Control.Monad++import qualified Data.Map as M+import Data.Map (Map)++parse :: Config -> String -> [String] -> IO [String]+parse cfg format eps+    = do series <- listAllSeries+         forM eps $ \ep -> case getElement (M.fromList [ (trunc name, name) | name <- series ]) ep of+                             Nothing  -> return ep+                             Just elt -> do titles <- getTitles cfg (name elt)+                                            case lookup (versionToIndex (version elt)) titles of+                                              Nothing -> return $ ppElement format elt+                                              Just txt -> return $ ppElement format elt{title = txt}++versionToIndex (Version season episode) = EpIdx season episode+versionToIndex (DateVersion y m d) = DateIdx y m d+++getElement :: Map String String -> String -> Maybe Element+getElement set str+    = let elts = run (parseElement set) str+      in if null elts+         then Nothing+         else Just (selectBest elts)
+ src/Rename.hs view
@@ -0,0 +1,17 @@+module Rename where++import Config+import Parse+import Storage++import System.FilePath+import Control.Monad+import System.Directory++rename :: Config -> String -> [FilePath] -> IO ()+rename cfg format paths+    = do ppNames <- parse cfg format (map takeFileName paths)+         forM_ (zip paths ppNames) $ \(path, parsed) ->+             do let dest = dropFileName path </> parsed+                when (confVerbose cfg >= 2) $ putStrLn $ path ++ " -> " ++ dest+                unless (confDryRun cfg) $ renameFile path dest
+ src/Setup.hs view
@@ -0,0 +1,187 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Setup+-- Copyright   :  (c) David Himmelstrup 2006+-- License     :  BSD-like+--+-- Maintainer  :  lemmih@gmail.com+-- Stability   :  provisional+-- Portability :  portable+--+--+-----------------------------------------------------------------------------+module Setup+    ( parseArguments+    , emptyConfig+    ) where++import Data.List+import Data.Char+import System.Console.GetOpt+import System.Exit+import System.Environment++import Config++emptyConfig :: Config+emptyConfig = Config+              { confVerbose  = 1+              , confWGetPath = "wget"+              , confCurlPath = "curl"+              , confTidyPath = "tidy"+              , confDryRun   = False }+++cmd_verbose :: OptDescr Flag+cmd_verbose = Option "v" ["verbose"] (OptArg verboseFlag "n")+              "Control verbosity (n is 0-5, normal verbosity level is 1, -v alone is equivalent to -v3)"+  where+    verboseFlag mb_s = Verbose (maybe 3 read mb_s)++cmd_dryrun :: OptDescr Flag+cmd_dryrun = Option "d" ["dry-run"] (OptArg dryrunFlag "bool")+              "Dry run. Accept values in the line of 'false', '0' and 'no'. Default: false."+  where+    dryrunFlag mb_s = DryRun (maybe True (parse.map toLower) mb_s)+    parse "false" = False+    parse "0" = False+    parse "no" = False+    parse _ = True++cmd_help :: OptDescr Flag+cmd_help = Option "h?" ["help"] (NoArg HelpFlag) "Show this help text"++globalOptions :: [OptDescr Flag]+globalOptions =+    [ cmd_help+    , cmd_verbose+    , cmd_dryrun+    , Option "w" ["wget-path"] (ReqArg WGetPath "path")+                 "Use this command as wget"+    , Option "t" ["tidy-path"] (ReqArg WGetPath "path")+                 "Use this command as tidy"+    ]++data Cmd = Cmd {+        cmdName         :: String,+        cmdHelp         :: String, -- Short description+        cmdDescription  :: String, -- Long description+        cmdOptions      :: [OptDescr Flag ],+        cmdAction       :: Action,+        cmdMerge        :: Flag -> Action -> Action+        }+++commandList :: [Cmd]+commandList = [ parseCmd, renameCmd, informCmd, addCmd, removeCmd ]++parseCmd = Cmd+           { cmdName = "parse"+           , cmdHelp = "Test the parser"+           , cmdDescription = ""+           , cmdOptions = [Option "f" ["format"] (ReqArg ParseFormat "format")+                                      ("Output format. Default: "++defaultFormat)+                          ]+           , cmdAction = Parse defaultFormat+           , cmdMerge = \(ParseFormat fn) a -> a{parseFormat = fn}}+renameCmd = Cmd+            { cmdName = "rename"+            , cmdHelp = "Rename TV series"+            , cmdDescription = ""+            , cmdOptions = [Option "f" ["format"] (ReqArg ParseFormat "format")+                                      ("Output format. Default: "++defaultFormat)+                          ]+            , cmdAction = Rename defaultFormat+            , cmdMerge = \(ParseFormat fn) a -> a{parseFormat = fn}}+informCmd = Cmd+            { cmdName = "inform"+            , cmdHelp = "Gather meta information"+            , cmdDescription = ""+            , cmdOptions = [Option "f" ["from-file"] (ReqArg (FromFile . parse) "series@file")+                                       ("Fetch info from file.")]+            , cmdAction = Inform []+            , cmdMerge = \f a -> case f of+                                   FromFile f -> a{fromFiles = f:fromFiles a}}+    where parse str = let (s,f) = break (=='@') str in (s,drop 1 f)++addCmd = Cmd+         { cmdName = "add"+         , cmdHelp = "Add new series. Case matters."+         , cmdDescription = ""+         , cmdOptions = []+         , cmdAction = Add+         , cmdMerge = \_ -> id }+removeCmd = Cmd+         { cmdName = "remove"+         , cmdHelp = "Remove series."+         , cmdDescription = ""+         , cmdOptions = []+         , cmdAction = Remove+         , cmdMerge = \_ -> id }+++lookupCommand :: String -> [Cmd] -> Maybe Cmd+lookupCommand name = find ((==name) . cmdName)+++mkConfig :: Flag -> Config -> Config+mkConfig (Verbose n) conf = conf { confVerbose = n }+mkConfig (WGetPath wget) conf = conf { confWGetPath = wget }+mkConfig (TidyPath tidy) conf = conf { confTidyPath = tidy }+mkConfig (DryRun d) conf = conf { confDryRun = d }+mkConfig _ _ = error "Setup.mkConfig: Invalid flag"++hasHelpFlag :: [Flag] -> Bool+hasHelpFlag flags = not . null $ [ () | HelpFlag <- flags ]++printUsage :: IO ()+printUsage =+    do pname <- getProgName+       let syntax_line = concat [ "Usage: ", pname+                                , " [GLOBAL FLAGS]\n  or:  COMMAND [FLAGS] "+                                , "\n\nGlobal flags:"]+       putStrLn (usageInfo syntax_line globalOptions)+       putStrLn "Commands:"+       let maxlen = maximum [ length (cmdName cmd) | cmd <- commandList ]+       sequence_ [ do putStr "  "+                      putStr (align maxlen (cmdName cmd))+                      putStr "    "+                      putStrLn (cmdHelp cmd)+                   | cmd <- commandList ]+       putStrLn $ "\nFor more information about a command, try '" ++ pname ++ " COMMAND --help'."+  where align n str = str ++ replicate (n - length str) ' '++printCmdUsage :: Cmd -> IO ()+printCmdUsage cmd+    = do pname <- getProgName+         let syntax_line = "Usage: " ++ pname ++ " " ++ cmdName cmd ++ " [FLAGS]\n\nFlags for " ++ cmdName cmd ++ ":"+         putStrLn (usageInfo syntax_line (cmd_help:cmdOptions cmd))+         putStrLn (cmdDescription cmd)+++parseArguments :: [String] -> IO (Action, [String], Config)+parseArguments args+    = case getOpt' RequireOrder globalOptions args of+        (flags, _, _, []) | hasHelpFlag flags ->+            do printUsage+               exitWith ExitSuccess+        (flags, cname:cargs, _, []) ->+            case lookupCommand cname commandList of+              Just cmd -> case getOpt' Permute (cmd_help:cmdOptions cmd) cargs of+                            (flags, _, _, []) | hasHelpFlag flags ->+                                do printCmdUsage cmd+                                   exitWith ExitSuccess+                            (cmdflags, args, _, []) -> +                                do return ( foldr (cmdMerge cmd) (cmdAction cmd) cmdflags+                                          , args+                                          , foldr mkConfig emptyConfig flags)+              Nothing -> do putStrLn $ "Unrecognised command: " ++ cname+                            exitWith (ExitFailure 1)+        (_, [], _, []) ->+            do putStrLn $ "No command given (try --help)"+               exitWith (ExitFailure 1)+        (_, _, _, errs) ->+            do putStrLn "Errors:"+               mapM_ putStrLn errs+               exitWith (ExitFailure 1)+
+ src/Storage.hs view
@@ -0,0 +1,85 @@+module Storage+    ( addSerie+    , removeSerie+    , getTitles+    , lookupSerieName+    , listAllSeries+    ) where++import System.Directory+import System.FilePath+import Control.Monad+import System.Exit+import System.Directory+import System.IO+import System.IO.Unsafe+import Data.List++import Utils+import Types+import Epguide+import Config++{-++$DATA/.augur/serie.titles++-}++addSerie :: SerieName -> IO ()+addSerie name+    = do file <- getTitlesFile name+         mbSerie <- lookupSerieName name+         case mbSerie of+           Nothing    -> writeFile file "[]"+           Just serie -> do hPutStrLn stderr $ "Serie already exist: " ++ serie+                            exitWith $ ExitFailure 1++removeSerie :: SerieName -> IO ()+removeSerie name+    = do mbSerie <- lookupSerieName name+         case mbSerie of+           Nothing    -> do hPutStrLn stderr $ "Unknown serie: " ++ name+           Just serie -> do file <- getTitlesFile serie+                            removeFile file+++getTitles :: Config -> SerieName -> IO [(LocalEpisodeIndex, String)]+getTitles cfg name+    = do mbSerie <- lookupSerieName name+         case mbSerie of+           Nothing    -> return []+           Just serie -> do lst <- fmap read . readFile =<< getTitlesFile serie+                            let lazyFetch = unsafePerformIO $+                                            do extra <- fetchTitles cfg serie+                                               let newElts = extra \\ lst+                                               unless (confDryRun cfg) $ setTitles serie extra+                                               return newElts+                            return $ lst ++ lazyFetch++setTitles :: SerieName -> [(LocalEpisodeIndex, String)] -> IO ()+setTitles serie lst+    = do tmp <- getTemporaryDirectory+         (path, handle) <- openTempFile tmp "titles.txt"+         hPrint handle lst+         hClose handle+         destPath <- getTitlesFile serie+         renameFile path destPath++-- trunc name -> name+lookupSerieName :: SerieName -> IO (Maybe SerieName)+lookupSerieName name+    = do series <- listAllSeries+         return $ lookup (trunc name) [ (trunc s, s) | s <- series ]++listAllSeries :: IO [SerieName]+listAllSeries =+    do dir <- getAppUserDataDirectory "augur"+       contents <- getDirectoryContents dir+       return $ nub $ map takeBaseName $ filter (`notElem` [".",".."]) contents++getTitlesFile :: SerieName -> IO FilePath+getTitlesFile name+    = do dir <- getAppUserDataDirectory "augur"+         createDirectoryIfMissing True dir+         return $ dir </> name <.> "titles"
+ src/Types.hs view
@@ -0,0 +1,45 @@+{-# OPTIONS -fglasgow-exts #-}+module Types where++import Data.Typeable+import Data.Map as Map+import Data.Set+import Data.ByteString++++type Title = String+type Summary = String+type Description = String+type Reason = String+type Hash = ByteString+type TicketId = Int+type TorrentId = Int+type SeriesId = Int+type SerieName = String+type SeasonId = Int+type EpisodeId = Int+type Year = Int+type Month = Int+type Day = Int+type EpisodeIndex = (SeriesId, LocalEpisodeIndex)+data LocalEpisodeIndex = EpIdx SeasonId EpisodeId+                       | DateIdx Year Month Day+                    deriving (Eq, Typeable)+instance Show LocalEpisodeIndex where+    show (EpIdx s e) = show (s,e)+    show (DateIdx y m d) = show (y,m,d)+instance Read LocalEpisodeIndex where+    readsPrec n str = do ((a,b),c) <- readsPrec n str+                         return (EpIdx a b,c)+                      +++                      do ((a,b,c),d) <- readsPrec n str+                         return (DateIdx a b c,d)+instance Ord LocalEpisodeIndex where+    compare (EpIdx s1 e1) (EpIdx s2 e2) = compare (s1,e1) (s2,e2)+    compare (DateIdx y1 m1 d1) (DateIdx y2 m2 d2) = compare (y1,m1,d1) (y2,m2,d2)+    compare (EpIdx _ _) (DateIdx _ _ _) = LT+    compare (DateIdx _ _ _) (EpIdx _ _) = GT++data TorrentTag = HR | HDTV | Proper | Repack | NoTag {- | OtherTag String -}+                  deriving (Show, Enum, Bounded,Typeable,Ord,Eq)
+ src/Utils.hs view
@@ -0,0 +1,121 @@+module Utils where++import Data.Char++import qualified Data.Map as M+import qualified Data.ByteString.Char8 as BS+import Numeric+import System.Process+import Text.XML.HaXml (xmlParse, Document)+import Data.Bits+import System.IO+import System.Exit+import Control.Monad.Trans+import Control.Monad++import Types+import Config++trunc :: String -> String+trunc cs = [ toLower c | c <- cs, isAlphaNum c ]++truncMinimal :: String -> String+truncMinimal = filter isAlphaNum++knownTags :: [TorrentTag]+knownTags = [minBound .. maxBound]++knownTagsMap :: M.Map String TorrentTag+knownTagsMap = M.fromList [ (map toLower (show tag), tag) | tag <- knownTags ]++extractTags :: String -> [TorrentTag]+extractTags str+    = let localTags = M.fromList [ (map toLower tag, ()) | tag <- splitWith isAlphaNum str ]+      in M.elems $ knownTagsMap `M.intersection` localTags++splitWith :: (a -> Bool) -> [a] -> [[a]]+splitWith _fn [] = []+splitWith fn lst+    = let (f,rest) = span fn lst+      in f:splitWith fn (dropWhile (not.fn) rest)+++showSize :: Int -> String+showSize n'+    = loop sizes (fromIntegral n')+    where loop [] n = showFFloat (Just 0) (n::Float) " bytes"+          loop ((s,p):xs) n | n >= s = showFFloat (Just 2) (n/s) p+                            | otherwise = loop xs n+          sizes = [ (giga, " GiB")+                  , (mega, " MiB")+                  , (kilo, " KiB")]+++kilo = 1024+mega = kilo*kilo+giga = mega*kilo++{-+getCurrentTime :: MonadIO m => m TimeStamp+getCurrentTime = liftIO $+    do TOD secs _ <- getClockTime+       return (fromIntegral secs)+-}++downloadToMem :: Config -> String -> IO BS.ByteString+downloadToMem cfg url+    = do when (confVerbose cfg >= 2) $ putStrLn $ "Downloading: " ++ url+         (_inh,outh,_errh,p) <- runInteractiveProcess (confWGetPath cfg)+                                ["--tries=3","-T","20","--quiet",url,"-O","-","-U","firefox"]+                                Nothing Nothing+         out <- BS.hGetContents outh+         waitForProcess p+         when (confVerbose cfg >= 2) $ putStrLn $ "Download finished: " ++ show (BS.length out) ++ "bytes"+         return out++mkGoogleUrl :: String -> String -> String+mkGoogleUrl site query+    = "http://www.google.com/search?hl=en&q=site%3A"++site++"+"++urlEncode query++"&btnI=I%27m+Feeling+Lucky"++htmlToXml :: Config -> BS.ByteString -> IO BS.ByteString+htmlToXml cfg html+    = do (inh, outh, _errh, p) <- runInteractiveProcess (confTidyPath cfg)+                                  ["-i","-asxml","-f","/dev/null"] Nothing Nothing+         BS.hPut inh html+         hFlush inh+         hClose inh+         out <- BS.hGetContents outh+         e <- waitForProcess p+         case e of+           ExitFailure 2 -> return ()+           _ -> return ()+         return out++downloadAsXML :: Config -> String -> IO Document+downloadAsXML cfg url+    = do html <- downloadToMem cfg url+         xml <- htmlToXml cfg html+         return $! xmlParse url (BS.unpack xml)++urlEncode :: String -> String+urlEncode (h:t) =+    let str = if reserved (ord h) then escape h else [h]+    in str ++ urlEncode t+    where+        reserved x+            | x >= ord 'a' && x <= ord 'z' = False+            | x >= ord 'A' && x <= ord 'Z' = False+            | x >= ord '0' && x <= ord '9' = False+            | x <= 0x20 || x >= 0x7F = True+            | otherwise = x `elem` map ord [';','/','?',':','@','&'+                                           ,'=','+',',','$','{','}'+                                           ,'|','\\','^','[',']','`'+                                           ,'<','>','#','%','"']+        -- wouldn't it be nice if the compiler+        -- optimised the above for us?++        escape x = +            let y = ord x +            in [ '%', intToDigit ((y `div` 16) .&. 0xf), intToDigit (y .&. 0xf) ]++urlEncode [] = []