Code clean-up using convertible-text.

[Lucu.git] / Network / HTTP / Lucu / DefaultPage.hs

diff --git a/Network/HTTP/Lucu/DefaultPage.hs b/Network/HTTP/Lucu/DefaultPage.hs
index e106774fafe6777faf7a066d7188f77df1e4a974..d95291764cf2ecd7c1b4c0e8beebe84a1f20744c 100644 (file)
--- a/Network/HTTP/Lucu/DefaultPage.hs
+++ b/Network/HTTP/Lucu/DefaultPage.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE
     OverloadedStrings
   , RecordWildCards
 {-# LANGUAGE
     OverloadedStrings
   , RecordWildCards

+  , ScopedTypeVariables

   , TypeOperators
   , UnicodeSyntax
   #-}
   , TypeOperators
   , UnicodeSyntax
   #-}


@@ -14,6 +15,7 @@ import Blaze.ByteString.Builder (Builder)
 import Data.Ascii (Ascii)
 import qualified Data.Ascii as A
 import qualified Data.CaseInsensitive as CI
 import Data.Ascii (Ascii)
 import qualified Data.Ascii as A
 import qualified Data.CaseInsensitive as CI

+import Data.Convertible.Utils

 import Data.Maybe
 import Data.Monoid.Unicode
 import Data.Text (Text)
 import Data.Maybe
 import Data.Monoid.Unicode
 import Data.Text (Text)


@@ -38,14 +40,14 @@ defaultPageForResponse ∷ Config → Maybe Request → Response → Builder
 defaultPageForResponse conf req res
     = defaultPageWithMessage conf (resStatus res) $ defaultMessage req res
 
 defaultPageForResponse conf req res
     = defaultPageWithMessage conf (resStatus res) $ defaultMessage req res
 

-defaultPageWithMessage ∷ StatusCode sc ⇒ Config → sc → Html → Builder
+defaultPageWithMessage ∷ ∀sc. StatusCode sc ⇒ Config → sc → Html → Builder

 {-# INLINEABLE defaultPageWithMessage #-}
 defaultPageWithMessage (Config {..}) sc msg
     = renderHtmlBuilder $
       do unsafeByteString "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
          docType
          html ! xmlns "http://www.w3.org/1999/xhtml" $
 {-# INLINEABLE defaultPageWithMessage #-}
 defaultPageWithMessage (Config {..}) sc msg
     = renderHtmlBuilder $
       do unsafeByteString "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
          docType
          html ! xmlns "http://www.w3.org/1999/xhtml" $

-             do let status = toHtml ∘ A.toText ∘ A.fromAsciiBuilder $ printStatusCode sc
+             do let status = toHtml $ scText sc

                 head $ title status
                 body $ do h1 status
                           p msg
                 head $ title status
                 body $ do h1 status
                           p msg


@@ -53,6 +55,9 @@ defaultPageWithMessage (Config {..}) sc msg
                           address $ do toHtml $ A.toText cnfServerSoftware
                                        unsafeByteString " at "
                                        toHtml $ CI.original cnfServerHost
                           address $ do toHtml $ A.toText cnfServerSoftware
                                        unsafeByteString " at "
                                        toHtml $ CI.original cnfServerHost

+    where
+      scText ∷ sc → Text
+      scText = convertSuccessVia ((⊥) ∷ Ascii) ∘ fromStatusCode

 
 defaultMessage ∷ Maybe Request → Response → Html
 {-# INLINEABLE defaultMessage #-}
 
 defaultMessage ∷ Maybe Request → Response → Html
 {-# INLINEABLE defaultMessage #-}