X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResource%2FInternal.hs;h=9feca7edf6e3b6401fc7e4306705a420553fe016;hp=f5b54a94d35f0a74a0efacc6ad7a7d6f6bc4f93d;hb=6680828c79aff38431704075c339e043b577589e;hpb=fffa09842d060c7d738084125dea07783d84aefe diff --git a/Network/HTTP/Lucu/Resource/Internal.hs b/Network/HTTP/Lucu/Resource/Internal.hs index f5b54a9..9feca7e 100644 --- a/Network/HTTP/Lucu/Resource/Internal.hs +++ b/Network/HTTP/Lucu/Resource/Internal.hs @@ -38,14 +38,15 @@ import Control.Concurrent import Control.Concurrent.STM import Control.Exception import Control.Monad hiding (mapM_) +import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Reader (ReaderT, runReaderT, ask) import Control.Monad.Unicode -import Data.Ascii (Ascii, CIAscii) -import qualified Data.Ascii as A +import Data.Ascii (Ascii, CIAscii, AsciiBuilder) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Collections +import Data.Convertible.Base import Data.List (intersperse, nub) import Data.Maybe import Data.Monoid @@ -75,7 +76,7 @@ newtype Rsrc a = Rsrc { unRsrc ∷ ReaderT NormalInteraction IO a } - deriving (Applicative, Functor, Monad, MonadIO) + deriving (Applicative, Functor, Monad, MonadFix, MonadIO) runRsrc ∷ Rsrc a → NormalInteraction → IO a runRsrc = runReaderT ∘ unRsrc @@ -179,10 +180,10 @@ spawnRsrc (Resource {..}) ni@(NI {..}) notAllowed ∷ Rsrc () notAllowed = do setStatus MethodNotAllowed setHeader "Allow" - $ A.fromAsciiBuilder + $ cs $ mconcat - $ intersperse (A.toAsciiBuilder ", ") - $ map A.toAsciiBuilder allowedMethods + $ intersperse (cs (", " ∷ Ascii) ∷ AsciiBuilder) + $ map cs allowedMethods allowedMethods ∷ [Ascii] allowedMethods = nub $ concat [ methods resGet ["GET"] @@ -271,7 +272,7 @@ getRequest = niRequest <$> getInteraction -- 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 +-- in 'Network.withSocketsDo' '.' 'Network.HTTP.Lucu.runHttpd' 'defaultConfig' $ 'Network.HTTP.Lucu.resourceMap' tree -- -- resFoo :: 'Resource' -- resFoo = 'singleton'