X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=ImplantFile.hs;fp=ImplantFile.hs;h=c3cff030271fd2e881be0d0db07180291858c9b2;hp=67633f763e3db855c6b4d4f6c39eeb62bb56aa1b;hb=ece223c516e66223ef1d5d8e6bbe4054a235d983;hpb=9668dc27a02b59d7bfb1e9e40af3d2619700ad69

diff --git a/ImplantFile.hs b/ImplantFile.hs
index 67633f7..c3cff03 100644
--- a/ImplantFile.hs
+++ b/ImplantFile.hs
@@ -41,27 +41,27 @@ data CmdOpt
     deriving (Eq, Show)
 
 options ∷ [OptDescr CmdOpt]
-options = [ Option ['o'] ["output"]
+options = [ Option "o" ["output"]
                        (ReqArg OptOutput "FILE")
                        "Output to the FILE."
 
-          , Option ['m'] ["module"]
+          , Option "m" ["module"]
                        (ReqArg OptModName "MODULE")
                        "Specify the resulting module name. (required)"
 
-          , Option ['s'] ["symbol"]
+          , Option "s" ["symbol"]
                        (ReqArg OptSymName "SYMBOL")
                        "Specify the resulting symbol name."
 
-          , Option ['t'] ["mime-type"]
+          , Option "t" ["mime-type"]
                        (ReqArg OptMIMEType "TYPE")
                        "Specify the MIME Type of the file."
 
-          , Option ['e'] ["etag"]
+          , Option "e" ["etag"]
                        (ReqArg OptETag "TAG")
                        "Specify the ETag of the file."
 
-          , Option ['h'] ["help"]
+          , Option "h" ["help"]
                        (NoArg OptHelp)
                        "Print this message."
           ]
@@ -126,19 +126,15 @@ generateHaskellSource opts srcFile
 
          let hsModule = mkModule modName symName imports decls
              imports  = mkImports useGZip
-             decls    = concat ([ resourceDecl symName useGZip
-                                , entityTagDecl eTag
-                                , lastModifiedDecl lastMod
-                                , contentTypeDecl mimeType
-                                ]
-                                ⧺
-                                if useGZip then
-                                    [ gunzipAndPutChunkDecl
-                                    , dataDecl (name "gzippedData") gzippedB64
-                                    ]
-                                else
-                                    [ dataDecl (name "rawData") rawB64 ]
-                               )
+             decls    = concat [ resourceDecl symName useGZip
+                               , entityTagDecl eTag
+                               , lastModifiedDecl lastMod
+                               , contentTypeDecl mimeType
+                               , if useGZip then
+                                     dataDecl (name "gzippedData") gzippedB64
+                                 else
+                                     dataDecl (name "rawData") rawB64
+                               ]
 
          hPutStrLn output header
          hPutStrLn output (prettyPrint hsModule)
@@ -163,16 +159,9 @@ mkImports useGZip
                    False False Nothing Nothing Nothing
       ]
       ⧺
-      if useGZip then
-          [ ImportDecl (⊥) (ModuleName "Blaze.ByteString.Builder.ByteString")
-                       True False Nothing (Just (ModuleName "BB")) Nothing
-          , ImportDecl (⊥) (ModuleName "Codec.Compression.Zlib.Internal")
-                       False False Nothing Nothing Nothing
-          , ImportDecl (⊥) (ModuleName "Data.Text")
-                       True False Nothing (Just (ModuleName "T")) Nothing
-          ]
-      else
-          []
+      [ ImportDecl (⊥) (ModuleName "Codec.Compression.GZip")
+                   False False Nothing Nothing Nothing
+        | useGZip ]
 
 resourceDecl ∷ Name → Bool → [Decl]
 resourceDecl symName useGZip
@@ -223,16 +212,18 @@ resGetGZipped
           = qualStmt $
             If (var condVarName)
                (doE [ setContentEncodingGZipStmt
-                    , outputStmt (var dataVarName)
+                    , putChunksStmt (var dataVarName)
                     ])
-               (function "gunzipAndPutChunk" `app` var dataVarName)
+               (putChunksExp
+                (paren
+                 (function "decompress" `app` var dataVarName)))
 
 resGetRaw ∷ Exp
 resGetRaw
     = function "Just" `app`
       paren (doE [ foundEntityStmt
                  , setContentTypeStmt
-                 , outputStmt (function "rawData")
+                 , putChunksStmt (function "rawData")
                  ])
 
 setContentEncodingGZipStmt ∷ Stmt
@@ -259,9 +250,11 @@ setContentTypeStmt
         function "contentType"
       )
 
-outputStmt ∷ Exp → Stmt
-outputStmt e
-    = qualStmt $ function "putChunk" `app` e
+putChunksExp ∷ Exp → Exp
+putChunksExp = app (function "putChunks")
+
+putChunksStmt ∷ Exp → Stmt
+putChunksStmt = qualStmt ∘ putChunksExp
 
 entityTagDecl ∷ ETag → [Decl]
 entityTagDecl eTag
@@ -279,6 +272,7 @@ lastModifiedDecl ∷ UTCTime → [Decl]
 lastModifiedDecl lastMod
     = [ TypeSig (⊥) [varName] (TyCon (UnQual (name "UTCTime")))
       , nameBind (⊥) varName valExp
+      , InlineSig (⊥) False AlwaysActive (UnQual varName)
       ]
     where
       varName ∷ Name
@@ -291,6 +285,7 @@ contentTypeDecl ∷ MIMEType → [Decl]
 contentTypeDecl mime
     = [ TypeSig (⊥) [varName] (TyCon (UnQual (name "MIMEType")))
       , nameBind (⊥) varName valExp
+      , InlineSig (⊥) False AlwaysActive (UnQual varName)
       ]
     where
       varName ∷ Name
@@ -302,88 +297,11 @@ contentTypeDecl mime
       mimeToString ∷ MIMEType → String
       mimeToString = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType
 
-gunzipAndPutChunkDecl ∷ [Decl]
-gunzipAndPutChunkDecl
-    = [ TypeSig (⊥) [funName]
-                    (TyFun (TyCon (Qual (ModuleName "Lazy") (name "ByteString")))
-                           tyResourceUnit)
-      , sfun (⊥) funName [] (UnGuardedRhs funExp) (binds goDecl)
-      ]
-    where
-      funName ∷ Name
-      funName = name "gunzipAndPutChunk"
-
-      goName ∷ Name
-      goName = name "go"
-
-      tyResourceUnit ∷ Type
-      tyResourceUnit
-          = TyApp (TyCon (UnQual (name "Resource")))
-                  (TyTuple Boxed [])
-
-      funExp ∷ Exp
-      funExp = var goName
-               `app`
-               function "."
-               `app`
-               metaFunction "decompressWithErrors"
-                                [ function "gzipFormat"
-                                , function "defaultDecompressParams"
-                                ]
-
-      goDecl ∷ [Decl]
-      goDecl = [ TypeSig (⊥) [goName]
-                             (TyFun (TyCon (UnQual (name "DecompressStream")))
-                                    tyResourceUnit)
-               , FunBind [ Match (⊥) goName [pvar (name "StreamEnd")]
-                                 Nothing (UnGuardedRhs endExp) (binds [])
-                         , Match (⊥) goName [pApp (name "StreamChunk")
-                                                  [ pvar (name "x")
-                                                  , pvar (name "xs") ]]
-                                 Nothing (UnGuardedRhs chunkExp) (binds [])
-                         , Match (⊥) goName [pApp (name "StreamError")
-                                                   [ wildcard
-                                                   , pvar (name "msg") ]]
-                                 Nothing (UnGuardedRhs errorExp) (binds [])
-                         ]
-               ]
-
-      endExp ∷ Exp
-      endExp = function "return" `app` tuple []
-
-      chunkExp ∷ Exp
-      chunkExp = function "putBuilder"
-                 `app`
-                 paren ( qvar (ModuleName "BB") (name "fromByteString")
-                         `app`
-                         var (name "x")
-                       )
-                 `app`
-                 function ">>"
-                 `app`
-                 function "go" `app` var (name "xs")
-
-      errorExp ∷ Exp
-      errorExp = metaFunction "abort"
-                 [ var (name "InternalServerError")
-                 , listE []
-                 , function "Just"
-                   `app`
-                   paren ( qvar (ModuleName "T") (name "pack")
-                           `app`
-                           paren ( strE "gunzip: "
-                                   `app`
-                                   function "++"
-                                   `app`
-                                   var (name "msg")
-                                 )
-                         )
-                 ]
-
 dataDecl ∷ Name → [Strict.ByteString] → [Decl]
 dataDecl varName chunks
     = [ TypeSig (⊥) [varName] (TyCon (Qual (ModuleName "Lazy") (name "ByteString")))
       , nameBind (⊥) varName valExp
+      , InlineSig (⊥) False AlwaysActive (UnQual varName)
       ]
     where
       valExp ∷ Exp
@@ -570,12 +488,15 @@ openOutput opts
   entityTag = strongETag "d41d8cd98f00b204e9800998ecf8427e"
 
   lastModified ∷ UTCTime
+  {-# NOINLINE lastModified #-}
   lastModified = read "2007-11-05 04:47:56.008366 UTC"
 
   contentType ∷ MIMEType
+  {-# NOINLINE contentType #-}
   contentType = parseMIMEType "image/png"
 
   rawData ∷ Lazy.ByteString
+  {-# NOINLINE rawData #-}
   rawData = Lazy.fromChunks
             [ B64.decodeLenient "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRG..."
             , B64.decodeLenient "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAA..."
@@ -585,9 +506,7 @@ openOutput opts
   壓縮される場合は次のやうに變はる:
   ------------------------------------------------------------------------------
   -- import に追加
-  import qualified Blaze.ByteString.Builder.ByteString as BB
-  import Codec.Compression.Zlib.Internal
-  import qualified Data.Text as T
+  import Codec.Compression.Zlib
 
   -- ResourceDef は次のやうに變化
   baz ∷ ResourceDef
@@ -601,9 +520,9 @@ openOutput opts
                         gzipAllowed ← isEncodingAcceptable "gzip"
                         if gzipAllowed then
                             do setContentEncoding ["gzip"]
-                               putChunk gzippedData
+                               putChunks gzippedData
                         else
-                            gunzipAndPutChunk gzippedData
+                            putChunks (decompress gzippedData)
         , resHead
             = Just $ do foundEntity entityTag lastModified
                         setContentType contentType
@@ -612,17 +531,9 @@ openOutput opts
         , resDelete = Nothing
         }
 
-  -- 追加
-  gunzipAndPutChunk :: Lazy.ByteString -> Resource ()
-  gunzipAndPutChunk = go . decompressWithErrors gzipFormat defaultDecompressParams
-      where
-        go :: DecompressStream -> Resource ()
-        go StreamEnd = return ()
-        go (StreamChunk x xs) = putBuilder (BB.fromByteString x) >> go xs
-        go (StreamError _ msg) = abort InternalServerError [] (Just (T.pack ("gunzip: " ++ msg)))
-  
   -- rawData の代はりに gzippedData
   gzippedData ∷ Lazy.ByteString
+  {-# NOINLINE gzippedData #-}
   gzippedData = Lazy.fromChunks
                 [ B64.decodeLenient "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQ..."
                 , B64.decodeLenient "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGA..."