1 module Rakka.Resource.Page.Get
7 import Control.Arrow.ArrowList
8 import Network.HTTP.Lucu
10 import Rakka.Environment
15 import Text.XML.HXT.Arrow.XmlArrow
16 import Text.XML.HXT.DOM.TypeDefs
22 Location: http://example.org/Destination?from=Source&revision=112
24 <page site="CieloNegro"
25 baseURI="http://example.org/"
27 redirect="Destination"
28 revision="112" -- デフォルトでない場合のみ存在
29 lastModified="2000-01-01T00:00:00" />
34 <page site="CieloNegro"
35 baseURI="http://example.org/"
38 isTheme="no" -- text/css の場合のみ存在
39 isFeed="no" -- text/x-rakka の場合のみ存在
41 revision="112"> -- デフォルトでない場合のみ存在
42 lastModified="2000-01-01T00:00:00" />
46 </summary> -- 存在しない場合もある
49 <link lang="ja" page="Bar/Baz" />
58 [text/* 以外の場合: content 要素の代はりに object 要素]
60 <object data="/object/Foo/Bar" /> -- data 屬性に URI
62 handleGet :: Environment -> PageName -> Resource ()
64 = let sto = envStorage env
66 runIdempotentA $ proc ()
67 -> do siteName <- getSiteNameA env -< ()
68 baseURI <- getBaseURIA env -< ()
70 pageM <- getPageA sto -< name
73 -> returnA -< foundNoEntity Nothing
75 Just redir@(Redirection _ _ _ _)
76 -> do tree <- ( eelem "/"
78 += sattr "site" siteName
79 += sattr "baseURI" (uriToString id baseURI "")
81 += sattr "redirect" (redirDest redir)
82 += ( case redirRevision redir of
84 Just rev -> sattr "revision" (show rev)
86 += sattr "lastModified" (formatW3CDateTime $ redirLastMod redir)
89 returnA -< do redirect SeeOther (mkPageURI baseURI name)
90 outputXmlPage tree redirToXHTML
93 redirToXHTML :: ArrowXml a => a XmlTree XmlTree
94 redirToXHTML = error "not implemented"