From: PHO <pho@cielonegro.org>
Date: Wed, 30 Nov 2011 15:47:59 +0000 (+0900)
Subject: docs
X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=commitdiff_plain;h=fffa09842d060c7d738084125dea07783d84aefe

docs

Ditz-issue: e0312227f40a0fa92d4c5d69a64dad473f54389a
---

diff --git a/Network/HTTP/Lucu/Abortion.hs b/Network/HTTP/Lucu/Abortion.hs
index 7b69fb5..db32c1d 100644
--- a/Network/HTTP/Lucu/Abortion.hs
+++ b/Network/HTTP/Lucu/Abortion.hs
@@ -2,8 +2,8 @@
     FlexibleContexts
   , UnicodeSyntax
   #-}
--- |Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource'
--- in any 'Prelude.IO' monads or arrows.
+-- |Aborting the computation of 'Network.HTTP.Lucu.Rsrc' in any 'IO'
+-- monads.
 module Network.HTTP.Lucu.Abortion
     ( Abortion
     , mkAbortion
@@ -49,7 +49,7 @@ mkAbortion' sc msg
       }
 
 -- |Throw an 'Abortion' in a 'MonadIO', including the very
--- 'Network.HTTP.Lucu.Resource.Resource' monad.
+-- 'Network.HTTP.Lucu.Rsrc' monad.
 abort ∷ MonadIO m ⇒ Abortion → m a
 {-# INLINE abort #-}
 abort = liftIO ∘ throwIO
diff --git a/Network/HTTP/Lucu/Abortion/Internal.hs b/Network/HTTP/Lucu/Abortion/Internal.hs
index 573dff0..69d7a9e 100644
--- a/Network/HTTP/Lucu/Abortion/Internal.hs
+++ b/Network/HTTP/Lucu/Abortion/Internal.hs
@@ -26,12 +26,12 @@ import Text.XML.HXT.Arrow.XmlArrow
 import Text.XML.HXT.Arrow.XmlState
 
 -- |'Abortion' is an 'Exception' that aborts the execution of
--- 'Network.HTTP.Lucu.Resource.Resource' monad with a 'StatusCode',
--- additional response headers, and an optional message text.
+-- 'Network.HTTP.Lucu.Rsrc' monad with a 'StatusCode', additional
+-- response headers, and an optional message text.
 --
--- 1. If the 'Network.HTTP.Lucu.Resource.Resource' is in the /Deciding
---    Header/ or any precedent states, throwing an 'Abortion' affects
---    the HTTP response to be sent to the client.
+-- 1. If the 'Network.HTTP.Lucu.Rsrc' is in the /Deciding Header/ or
+--    any precedent states, throwing an 'Abortion' affects the HTTP
+--    response to be sent to the client.
 --
 -- 2. Otherwise it's too late to overwrite the HTTP response so the
 --    only possible thing the system can do is to dump the exception
@@ -41,9 +41,11 @@ import Text.XML.HXT.Arrow.XmlState
 -- 'isError' so you can abuse this exception for redirections as well
 -- as error reporting e.g.
 --
--- > abort $ mkAbortion MovedPermanently
--- >         [("Location", "http://example.net/")]
--- >         "It has been moved to example.net"
+-- @
+--   'Network.HTTP.Lucu.abort' '$' 'Network.HTTP.Lucu.mkAbortion' 'MovedPermanently'
+--           [(\"Location\", \"http://example.net/\")]
+--           ('Just' \"It's been moved to example.net.\")
+-- @
 data Abortion = Abortion {
       aboStatus  ∷ !SomeStatusCode
     , aboHeaders ∷ !Headers
diff --git a/Network/HTTP/Lucu/Authentication.hs b/Network/HTTP/Lucu/Authentication.hs
index 495c931..29ae0e9 100644
--- a/Network/HTTP/Lucu/Authentication.hs
+++ b/Network/HTTP/Lucu/Authentication.hs
@@ -27,7 +27,7 @@ import Prelude.Unicode
 
 -- |Authentication challenge to be sent to clients with
 -- \"WWW-Authenticate\" header field. See
--- 'Network.HTTP.Lucu.Resource.setWWWAuthenticate'.
+-- 'Network.HTTP.Lucu.setWWWAuthenticate'.
 data AuthChallenge
     = BasicAuthChallenge !Realm
       deriving (Eq)
@@ -36,8 +36,7 @@ data AuthChallenge
 type Realm = Ascii
 
 -- |Authorization credential to be sent by client with
--- \"Authorization\" header. See
--- 'Network.HTTP.Lucu.Resource.getAuthorization'.
+-- \"Authorization\" header. See 'Network.HTTP.Lucu.getAuthorization'.
 data AuthCredential
     = BasicAuthCredential !UserID !Password
       deriving (Show, Eq)
diff --git a/Network/HTTP/Lucu/Config.hs b/Network/HTTP/Lucu/Config.hs
index 80845bd..7a2d81f 100644
--- a/Network/HTTP/Lucu/Config.hs
+++ b/Network/HTTP/Lucu/Config.hs
@@ -120,3 +120,4 @@ defaultConfig = Config {
                 , cnfDumpTooLateAbortionToStderr = True
                 , cnfExtToMIMEType               = defaultExtensionMap
                 }
+-- FIXME: use data-default.
diff --git a/Network/HTTP/Lucu/Dispatcher/Internal.hs b/Network/HTTP/Lucu/Dispatcher/Internal.hs
index 80effa7..6e088df 100644
--- a/Network/HTTP/Lucu/Dispatcher/Internal.hs
+++ b/Network/HTTP/Lucu/Dispatcher/Internal.hs
@@ -79,8 +79,8 @@ class ResourceMapper α where
 -- |Container type for the 'ResourceMapper' type class.
 data ResourceMap = ∀α. ResourceMapper α ⇒ RMap α
 
--- |'ResourceTree' is an opaque structure which is a map from resource
--- path to 'Resource'.
+-- |'ResourceTree' is an opaque structure which a map from resource
+-- 'Path' to 'ResourceNode'.
 --
 -- @
 --   'fromList' [ ([]        , 'nonGreedy' '$' 'Network.HTTP.Lucu.StaticFile.staticFile' \"\/usr\/include\/stdio.h\" ) -- \/
@@ -96,7 +96,8 @@ data ResourceMap = ∀α. ResourceMapper α ⇒ RMap α
 newtype ResourceTree = Tree (M.Map Path ResourceNode)
     deriving Monoid
 
--- |FIXME: doc
+-- |A node of 'Resource' located somewhere in a 'ResourceTree'. Such
+-- nodes are either 'greedy' or 'nonGreedy'.
 data ResourceNode
     = Greedy    { nResource ∷ !Resource }
     | NonGreedy { nResource ∷ !Resource }
@@ -106,12 +107,13 @@ data ResourceNode
 -- Say a client is trying to access \"\/aaa\/bbb\/ccc\' while there is
 -- no resource node at the path. If there are greedy resource nodes at
 -- \"\/aaa\/bbb\", \"\/aaa\" or \"/\" they will be chosen instead as a
--- fallback. Greedy resource nodes are searched in depth-first order.
+-- fallback. Greedy resource nodes are searched in depth-first
+-- order, just like CGI scripts.
 greedy ∷ Resource → ResourceNode
 {-# INLINE CONLIKE greedy #-}
 greedy = Greedy
 
--- |FIXME: doc
+-- |Make a normal, non-greedy resource node.
 nonGreedy ∷ Resource → ResourceNode
 {-# INLINE CONLIKE nonGreedy #-}
 nonGreedy = NonGreedy
diff --git a/Network/HTTP/Lucu/Resource.hs b/Network/HTTP/Lucu/Resource.hs
index 0ff5081..652c5f7 100644
--- a/Network/HTTP/Lucu/Resource.hs
+++ b/Network/HTTP/Lucu/Resource.hs
@@ -212,9 +212,8 @@ getRequestVersion ∷ Rsrc HttpVersion
 getRequestVersion = reqVersion <$> getRequest
 
 -- |This is an analogy of CGI PATH_INFO. 'getPathInfo' always returns
--- @[]@ if the corresponding
--- 'Network.HTTP.Lucu.Resource.Tree.Resource' is not greedy. See:
--- 'getResourcePath'
+-- @[]@ if the corresponding 'Resource' is not greedy. See
+-- 'getResourcePath'.
 --
 -- Note that the returned path components are URI-decoded.
 getPathInfo ∷ Rsrc [Strict.ByteString]
@@ -667,7 +666,7 @@ setWWWAuthenticate = setHeader "WWW-Authenticate" ∘ printAuthChallenge
 
 -- |Write a chunk in 'Strict.ByteString' to the response body. You
 -- must first declare the response header \"Content-Type\" before
--- applying this function. See: 'setContentType'
+-- applying this function. See 'setContentType'.
 putChunk ∷ Strict.ByteString → Rsrc ()
 putChunk = putBuilder ∘ BB.fromByteString
 
@@ -675,7 +674,7 @@ putChunk = putBuilder ∘ BB.fromByteString
 -- can be safely applied to an infinitely long 'Lazy.ByteString'.
 --
 -- Note that you must first declare the response header
--- \"Content-Type\" before applying this function. See:
--- 'setContentType'
+-- \"Content-Type\" before applying this function. See
+-- 'setContentType'.
 putChunks ∷ Lazy.ByteString → Rsrc ()
 putChunks = putBuilder ∘ BB.fromLazyByteString
diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs
index f6d17b6..f5b54a9 100644
--- a/Network/HTTP/Lucu/Resource/Internal.hs
+++ b/Network/HTTP/Lucu/Resource/Internal.hs
@@ -261,25 +261,30 @@ getRequest ∷ Rsrc Request
 getRequest = niRequest <$> getInteraction
 
 -- |Get the path of this 'Rsrc' (to be exact, 'Resource') in the
--- 'Network.HTTP.Lucu.Resource.Tree.ResTree'. The result of this
+-- corresponding 'Network.HTTP.Lucu.ResourceTree'. The result of this
 -- action is the exact path in the tree even when the 'Resource' is
--- greedy.
+-- 'Network.HTTP.Lucu.greedy'.
 --
 -- Example:
 --
--- > main = let tree = mkResTree [ (["foo"], resFoo) ]
--- >        in runHttpd defaultConfig tree []
--- >
--- > resFoo = emptyResource {
--- >     resIsGreedy = True
--- >   , resGet = Just $ do requestURI   <- getRequestURI
--- >                        resourcePath <- getResourcePath
--- >                        pathInfo     <- getPathInfo
--- >                        -- uriPath requestURI == "/foo/bar/baz"
--- >                        -- resourcePath       == ["foo"]
--- >                        -- pathInfo           == ["bar", "baz"]
--- >                        ...
--- >   }
+-- @
+--   main :: 'IO' ()
+--   main = let tree :: 'Network.HTTP.Lucu.ResourceTree'
+--              tree = 'fromList' [ (["foo"], 'Network.HTTP.Lucu.greedy' resFoo) ]
+--          in 'Network.HTTP.Lucu.runHttpd' 'defaultConfig' $ 'Network.HTTP.Lucu.resourceMap' tree
+--
+--   resFoo :: 'Resource'
+--   resFoo = 'singleton'
+--            ( 'GET'
+--            , do requestURI   <- 'getRequestURI'
+--                 resourcePath <- 'getResourcePath'
+--                 pathInfo     <- 'getPathInfo'
+--                 -- 'Network.URI.uriPath' requestURI '==' \"/foo/bar/baz\"
+--                 -- resourcePath       == ["foo"]
+--                 -- pathInfo           == ["bar", "baz"]
+--                 ...
+--            )
+-- @
 getResourcePath ∷ Rsrc Path
 getResourcePath = niResourcePath <$> getInteraction
 
@@ -330,7 +335,7 @@ setStatus sc
 -- |@'setHeader' name value@ declares the value of the response header
 -- @name@ as @value@. Note that this function is not intended to be
 -- used so frequently: there should be specialised functions like
--- 'setContentType' for every common headers.
+-- 'Network.HTTP.Lucu.setContentType' for every common headers.
 --
 -- Some important headers (especially \"Content-Length\" and
 -- \"Transfer-Encoding\") may be silently dropped or overwritten by
@@ -375,8 +380,8 @@ deleteHeader name = liftIO ∘ atomically ∘ go =≪ getInteraction
 -- infinitely long stream of octets.
 --
 -- Note that you must first declare the response header
--- \"Content-Type\" before applying this function. See:
--- 'setContentType'
+-- \"Content-Type\" before applying this function. See
+-- 'Network.HTTP.Lucu.setContentType'.
 putBuilder ∷ Builder → Rsrc ()
 putBuilder b = liftIO ∘ atomically ∘ go =≪ getInteraction
     where
diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index 826cc0e..c18819f 100644
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -92,32 +92,32 @@ printResponse (Response {..})
       A.toAsciiBuilder "\x0D\x0A" ⊕
       printHeaders     resHeaders
 
--- |@'isInformational' sc@ returns 'True' iff @sc < 200@.
+-- |@'isInformational' sc@ returns 'True' iff @sc '<' 200@.
 isInformational ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isInformational #-}
 isInformational = satisfy (< 200)
 
--- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
+-- |@'isSuccessful' sc@ returns 'True' iff @200 '<=' sc '<' 300@.
 isSuccessful ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isSuccessful #-}
 isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
 
--- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
+-- |@'isRedirection' sc@ returns 'True' iff @300 '<=' sc '<' 400@.
 isRedirection ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isRedirection #-}
 isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
 
--- |@'isError' sc@ returns 'True' iff @400 <= sc@
+-- |@'isError' sc@ returns 'True' iff @400 '<=' sc@
 isError ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isError #-}
 isError = satisfy (≥ 400)
 
--- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
+-- |@'isClientError' sc@ returns 'True' iff @400 '<=' sc '<' 500@.
 isClientError ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isClientError #-}
 isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
 
--- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
+-- |@'isServerError' sc@ returns 'True' iff @500 '<=' sc@.
 isServerError ∷ StatusCode sc ⇒ sc → Bool
 {-# INLINE isServerError #-}
 isServerError = satisfy (≥ 500)
diff --git a/Network/HTTP/Lucu/StaticFile.hs b/Network/HTTP/Lucu/StaticFile.hs
index 5ed214a..a1b6115 100644
--- a/Network/HTTP/Lucu/StaticFile.hs
+++ b/Network/HTTP/Lucu/StaticFile.hs
@@ -72,7 +72,9 @@ handleStaticFile sendContent path
              $ liftIO (LBS.readFile path) ≫= putChunks
 
 -- | @'staticDir' dir@ is a 'Resource' which maps all files in @dir@
--- and its subdirectories on the filesystem to the resource tree.
+-- and its subdirectories on the filesystem to the resource tree. Thus
+-- having 'Network.HTTP.Lucu.nonGreedy' 'staticDir' in a tree makes no
+-- sense.
 --
 -- Note that 'staticDir' currently doesn't have a directory-listing
 -- capability. Requesting the content of a directory will end up being
diff --git a/Network/HTTP/Lucu/StatusCode/Internal.hs b/Network/HTTP/Lucu/StatusCode/Internal.hs
index 24988ee..d6e892b 100644
--- a/Network/HTTP/Lucu/StatusCode/Internal.hs
+++ b/Network/HTTP/Lucu/StatusCode/Internal.hs
@@ -53,8 +53,8 @@ instance Eq SomeStatusCode where
     (SomeStatusCode α) == (SomeStatusCode β) = α ≈ β
 
 infix 4 ≈, ≉
--- |Two 'StatusCode's @a@ and @b@ are said to be equivalent iff
--- @'numericCode' a '==' 'numericCode' b@.
+-- |Equivalence of 'StatusCode's. Two 'StatusCode's @a@ and @b@ are
+-- said to be equivalent iff @'numericCode' a '==' 'numericCode' b@.
 --
 -- U+2248, ALMOST EQUAL TO
 (≈) ∷ (StatusCode α, StatusCode β) ⇒ α → β → Bool
diff --git a/Network/HTTP/Lucu/Utils.hs b/Network/HTTP/Lucu/Utils.hs
index 7623c70..9abaf1e 100644
--- a/Network/HTTP/Lucu/Utils.hs
+++ b/Network/HTTP/Lucu/Utils.hs
@@ -137,21 +137,21 @@ trim = reverse ∘ f ∘ reverse ∘ f
       f = dropWhile isSpace
 
 infixr 5 ⊲
--- | (&#22B2;) = ('<|')
+-- | (&#x22B2;) = ('<|')
 --
 -- U+22B2, NORMAL SUBGROUP OF
 (⊲) ∷ Sequence α a ⇒ a → α → α
 (⊲) = (<|)
 
 infixl 5 ⊳
--- | (&#22B3;) = ('|>')
+-- | (&#x22B3;) = ('|>')
 --
 -- U+22B3, CONTAINS AS NORMAL SUBGROUP
 (⊳) ∷ Sequence α a ⇒ α → a → α
 (⊳) = (|>)
 
 infixr 5 ⋈
--- | (&#22C8;) = ('><')
+-- | (&#x22C8;) = ('><')
 --
 -- U+22C8, BOWTIE
 (⋈) ∷ Sequence α a ⇒ α → α → α
diff --git a/examples/SSL.hs b/examples/SSL.hs
index 624ed04..aa8b3a5 100644
--- a/examples/SSL.hs
+++ b/examples/SSL.hs
@@ -42,17 +42,16 @@ main = withOpenSSL $
 
 helloWorld ∷ Resource
 helloWorld 
-    = C.fromList
-      [ ( GET
-        , do setContentType [mimeType| text/plain |]
-             putChunk "getRemoteCertificate = "
-             cert ← do cert ← getRemoteCertificate
-                       case cert of
-                         Just c  → liftIO $ Lazy.pack <$> printX509 c
-                         Nothing → return "Nothing"
-             putChunks cert
-        )
-      ]
+    = C.singleton
+      ( GET
+      , do setContentType [mimeType| text/plain |]
+           putChunk "getRemoteCertificate = "
+           cert ← do cert ← getRemoteCertificate
+                     case cert of
+                       Just c  → liftIO $ Lazy.pack <$> printX509 c
+                       Nothing → return "Nothing"
+           putChunks cert
+      )
 
 genCert ∷ KeyPair k ⇒ k → IO X509
 genCert pkey