X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FImplant%2FPrettyPrint.hs;h=22e3a74538c3a3342a74979c45d60382a3742c63;hb=0678be80d2cab7c670aba82659bde87ba84b926b;hp=ecdb4fe8aed35dacc39f1f4234060d366cc1a070;hpb=cc074d0ce3f7df2544bc2baddca4e7730ecdf0a0;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Implant/PrettyPrint.hs b/Network/HTTP/Lucu/Implant/PrettyPrint.hs
index ecdb4fe..22e3a74 100644
--- a/Network/HTTP/Lucu/Implant/PrettyPrint.hs
+++ b/Network/HTTP/Lucu/Implant/PrettyPrint.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE
     DoAndIfThenElse
+  , FlexibleContexts
+  , MultiParamTypeClasses
   , OverloadedStrings
   , RecordWildCards
   , TemplateHaskell
@@ -14,12 +16,14 @@ module Network.HTTP.Lucu.Implant.PrettyPrint
     where
 import Codec.Compression.GZip
 import Control.Monad
-import Data.Ascii (CIAscii)
-import qualified Data.Ascii as A
+import Data.Ascii (Ascii, CIAscii)
 import qualified Data.ByteString.Lazy as L
 import Data.Char
-import Data.Foldable
-import Data.List
+import Data.Collections
+import Data.Convertible.Base
+import Data.Convertible.Utils
+import Data.List (intersperse)
+import Data.Monoid
 import Data.Ratio
 import Data.Time
 import Language.Haskell.TH.Lib
@@ -30,8 +34,9 @@ import Network.HTTP.Lucu.ETag
 import Network.HTTP.Lucu.Implant
 import Network.HTTP.Lucu.Implant.Rewrite
 import Network.HTTP.Lucu.MIMEType
+import Network.HTTP.Lucu.OrphanInstances ()
 import Network.HTTP.Lucu.Resource
-import Network.HTTP.Lucu.Utils
+import Prelude hiding (head)
 import Prelude.Unicode
 
 header ∷ Input → Doc
@@ -57,19 +62,16 @@ header i@(Input {..})
                              ]
                     else
                         text "      Compression: disabled"
-                  , text "        MIME Type:" <+> mimeTypeToDoc iType
-                  , text "             ETag:" <+> eTagToDoc iETag
+                  , text "        MIME Type:" <+> toDoc iType
+                  , text "             ETag:" <+> toDoc iETag
                   , text "    Last Modified:" <+> text (show iLastMod)
                   ]
            , text " -}"
            , text "{-# LANGUAGE MagicHash #-}"
            ]
     where
-      eTagToDoc ∷ ETag → Doc
-      eTagToDoc = text ∘ A.toString ∘ A.fromAsciiBuilder ∘ printETag
-
-      mimeTypeToDoc ∷ MIMEType → Doc
-      mimeTypeToDoc = text ∘ A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType
+      toDoc ∷ ConvertSuccess α Ascii ⇒ α → Doc
+      toDoc = text ∘ convertSuccessVia ((⊥) ∷ Ascii)
 
 moduleDecl ∷ ModName → Name → Doc
 moduleDecl modName symName
@@ -79,8 +81,8 @@ moduleDecl modName symName
                    , text "where"
                    ])
 
-importDecls ∷ Imports ImportOp → Doc
-importDecls = vcat ∘ map pprImport ∘ toList
+importDecls ∷ Imports → Doc
+importDecls = vcat ∘ map pprImport ∘ fromFoldable
 
 pprImport ∷ ImportOp → Doc
 pprImport (QualifiedImp {..})
@@ -100,7 +102,7 @@ pprImport (UnqualifiedImp {impNames = Just ns, ..})
            , hcat [ lparen
                   , sep $ punctuate comma
                         $ map (uncurry pprImpName)
-                        $ toList ns
+                        $ fromFoldable ns
                   , rparen
                   ]
            ]
@@ -138,20 +140,20 @@ gzipEncoding = mkName "gzipEncoding"
 
 resourceDecl ∷ Input → Name → Q [Dec]
 resourceDecl i symName
-    = sequence [ sigD symName [t| ResourceDef |]
+    = sequence [ sigD symName [t| Resource |]
                , valD (varP symName) (normalB (resourceE i)) decls
                ]
     where
       decls ∷ [Q Dec]
       decls | useGZip i
                 = [ sigD gzipEncoding [t| CIAscii |]
-                  , valD (varP gzipEncoding) (normalB (liftCIAscii "gzip")) []
+                  , valD (varP gzipEncoding) (normalB (lift ("gzip" ∷ CIAscii))) []
                   ]
             | otherwise
                 = []
 
 resourceE ∷ Input → Q Exp
-resourceE i = [| emptyResource {
+resourceE i = [| mempty {
                    resGet  = $(resGetE  i)
                  , resHead = $(resHeadE i)
                  }
@@ -203,7 +205,7 @@ eTagDecl (Input {..})
 lastModDecl ∷ Input → Q [Dec]
 lastModDecl (Input {..})
     = sequence [ sigD lastModified [t| UTCTime |]
-               , valD (varP lastModified) (normalB (liftUTCTime iLastMod)) []
+               , valD (varP lastModified) (normalB (lift iLastMod)) []
                ]
 
 contTypeDecl ∷ Input → Q [Dec]
@@ -216,11 +218,11 @@ binDecl ∷ Input → Q [Dec]
 binDecl i@(Input {..})
     | useGZip i
         = sequence [ sigD gzippedData [t| L.ByteString |]
-                   , valD (varP gzippedData) (normalB (liftLazyByteString iGZipped)) []
+                   , valD (varP gzippedData) (normalB (lift iGZipped)) []
                    ]
     | otherwise
         = sequence [ sigD rawData [t| L.ByteString |]
-                   , valD (varP rawData) (normalB (liftLazyByteString iRawData)) []
+                   , valD (varP rawData) (normalB (lift iRawData)) []
                    ]
 
 rules ∷ Rules
@@ -229,14 +231,15 @@ rules = [ qualifyAll   "Codec.Compression.GZip"              "G"
         , qualifyAll   "Data.Ascii"                          "A"
         , qualifyAll   "Data.ByteString.Char8"               "B"
         , qualifyAll   "Data.ByteString.Lazy.Internal"       "L"
-        , qualifyAll   "Data.Map"                            "M"
+        , qualifyAll   "Data.CaseInsensitive"                "CI"
+        , qualifyAll   "Data.Collections"                    "C"
         , qualifyAll   "Data.Text"                           "T"
         , unqualifyAll "Network.HTTP.Lucu.ETag"              "Network.HTTP.Lucu"
         , unqualifyAll "Network.HTTP.Lucu.Resource"          "Network.HTTP.Lucu"
         , unqualifyAll "Network.HTTP.Lucu.Resource.Internal" "Network.HTTP.Lucu"
-        , unqualifyAll "Network.HTTP.Lucu.MIMEParams"        "Network.HTTP.Lucu"
         , unqualifyAll "Network.HTTP.Lucu.MIMEType"          "Network.HTTP.Lucu"
         , unqualify    'when                                 "Control.Monad"
+        , unqualify    'mempty                               "Data.Monoid"
         , unqualify    '(%)                                  "Data.Ratio"
         , unqualify    ''DiffTime                            "Data.Time"
         , unqualifyIn  'ModifiedJulianDay  ''Day             "Data.Time"