#!/usr/pkg/bin/runhugs +l
-- Hey, Emacs, this is -*- haskell -*-
-- A demo of a GUI   Erik Meijer (erik@cs.ruu.nl)

\begin{code}
module Main (main) where

import CGI

main :: IO ()
main = simpleWrapper paperForm

paperForm :: [(Name,Value)] -> CgiOut HTML
paperForm env =
   maybe presentChoice
         (\paper -> deliverPaper paper (lookup "media" env))
         (lookup "Paper" env)

deliverPaper ::  String -> Maybe String -> CgiOut HTML
deliverPaper paper (Just "ps") =
   maybe (paperNotFound paper "ps")
         (\paper -> Location{ url = root++"/ps/"++paper++".ps" })
         (lookup paper psPapers)
deliverPaper paper (Just "dvi") =
   maybe (paperNotFound paper "dvi")
         (\paper -> Location{ url = root++"/dvi/"++paper++".dvi" })
         (lookup paper dviPapers)
deliverPaper paper Nothing = paperNotFound paper "this"

paperNotFound :: String -> String -> CgiOut HTML
paperNotFound paper media
 = Content{ mime = page "Paper Not Found" []
                    [ prose "Your requested paper "
                    , format "STRONG"  paper
                    , prose " is not available in "
                    , format "STRONG" media
                    , prose " format! "
                    , href downloadPapers
                        [prose "Please, make another choice."]]}

presentChoice :: CgiOut HTML
presentChoice
 = Content{ mime = page "Erik's Papers" []
                    [ h1 "Download my research papers"
                    , gui downloadPapers
                       [ menu "Paper"
                          [ mondrian
                          , bananas
                          , bananas_in_space
                          , henk
                          , parsers
                          , back_to_basics
                          , type_classes
                          ]
                        , (radio `group` "media") ["ps", "dvi"]
                        , submit "" "Submit", reset "" "Reset" ]]}

downloadPapers :: String
downloadPapers   = "http://www.cse.ogi.edu/~erik/cgi-bin/download.cgi"

mondrian, bananas, bananas_in_space, henk :: String
parsers, back_to_basics, type_classes :: String
mondrian         = "The Design and Implementation of Mondrian"
bananas          = "Functional Programming With Bananas, Lenses and Barded Wire"
bananas_in_space = "Bananas in Space"
henk             = "Henk"
parsers          = "Monadic Parser Combinators"
back_to_basics   = "Back to Basics"
type_classes     = "Type Classes in Haskell 1.4 and beyond"

root :: String
root             = "http://www.cse.ogi.edu/~erik/Papers"

psPapers :: [(String,String)]
psPapers
 = [ (mondrian         , "mondrian")
   , (bananas          , "bananas")
   , (bananas_in_space , "space")
   , (henk             , "henk")
   , (parsers          , "parsing")
   , (back_to_basics   , "basics")
   , (type_classes     , "multi")
   ]

dviPapers :: [(String,String)]
dviPapers
 = [ (mondrian         , "mondrian")
   , (henk             , "henk")
   , (type_classes     , "multi")
   ]
