Make use of mimeType quasi-quoter.

[Lucu.git] / ImplantFile.hs

diff --git a/ImplantFile.hs b/ImplantFile.hs
index b085a9876b859c4463c11609524da25082b48f4d..c253c2abd05395b3311dba1fd9d3ed999d37d89b 100644 (file)
--- 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."
           ]
@@ -106,13 +106,13 @@ main = do (opts, sources, errors) ← getOpt Permute options <$> getArgs
 
 generateHaskellSource ∷ [CmdOpt] → FilePath → IO ()
 generateHaskellSource opts srcFile
-    = do modName  ← getModuleName opts
-         symName  ← getSymbolName opts modName
-         mimeType ← getMIMEType opts srcFile
-         lastMod  ← getLastModified srcFile
-         input    ← openInput srcFile
-         output   ← openOutput opts
-         eTag     ← getETag opts input
+    = do modName ← getModuleName opts
+         symName ← getSymbolName opts modName
+         mType   ← getMIMEType opts srcFile
+         lastMod ← getLastModified srcFile
+         input   ← openInput srcFile
+         output  ← openOutput opts
+         tag     ← getETag opts input
 
          let compParams  = defaultCompressParams { compressLevel = bestCompression }
              gzippedData = compressWith compParams input
@@ -122,14 +122,14 @@ generateHaskellSource opts srcFile
              rawB64      = B64.encode <$> Lazy.toChunks input
              gzippedB64  = B64.encode <$> Lazy.toChunks gzippedData
 
-         header ← mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod
+         header ← mkHeader srcFile originalLen gzippedLen useGZip mType tag lastMod
 
          let hsModule = mkModule modName symName imports decls
              imports  = mkImports useGZip
              decls    = concat [ resourceDecl symName useGZip
-                               , entityTagDecl eTag
+                               , entityTagDecl tag
                                , lastModifiedDecl lastMod
-                               , contentTypeDecl mimeType
+                               , contentTypeDecl mType
                                , if useGZip then
                                      dataDecl (name "gzippedData") gzippedB64
                                  else
@@ -161,8 +161,7 @@ mkImports useGZip
       ⧺
       [ ImportDecl (⊥) (ModuleName "Codec.Compression.GZip")
                    False False Nothing Nothing Nothing
-        | useGZip
-      ]
+        | useGZip ]
 
 resourceDecl ∷ Name → Bool → [Decl]
 resourceDecl symName useGZip
@@ -171,7 +170,7 @@ resourceDecl symName useGZip
       ]
     where
       valExp ∷ Exp
-      valExp = RecUpdate (var $ name "emptyResource")
+      valExp = RecUpdate (function "emptyResource")
                [ FieldUpdate (UnQual (name "resGet" )) resGet
                , FieldUpdate (UnQual (name "resHead")) resHead
                ]
@@ -213,19 +212,18 @@ resGetGZipped
           = qualStmt $
             If (var condVarName)
                (doE [ setContentEncodingGZipStmt
-                    , outputStmt (var dataVarName)
+                    , putChunksStmt (var dataVarName)
                     ])
-               ( function "output"
-                 `app`
-                 paren (function "decompress" `app` var dataVarName)
-               )
+               (putChunksExp
+                (paren
+                 (function "decompress" `app` var dataVarName)))
 
 resGetRaw ∷ Exp
 resGetRaw
     = function "Just" `app`
       paren (doE [ foundEntityStmt
                  , setContentTypeStmt
-                 , outputStmt (var $ name "rawData")
+                 , putChunksStmt (function "rawData")
                  ])
 
 setContentEncodingGZipStmt ∷ Stmt
@@ -240,8 +238,8 @@ foundEntityStmt ∷ Stmt
 foundEntityStmt
     = qualStmt $
       metaFunction "foundEntity"
-                       [ var $ name "entityTag"
-                       , var $ name "lastModified"
+                       [ var (name "entityTag")
+                       , var (name "lastModified")
                        ]
 
 setContentTypeStmt ∷ Stmt
@@ -249,15 +247,17 @@ setContentTypeStmt
     = qualStmt
       ( function "setContentType"
         `app`
-        var (name "contentType")
+        function "contentType"
       )
 
-outputStmt ∷ Exp → Stmt
-outputStmt e
-    = qualStmt $ function "output" `app` e
+putChunksExp ∷ Exp → Exp
+putChunksExp = app (function "putChunks")
+
+putChunksStmt ∷ Exp → Stmt
+putChunksStmt = qualStmt ∘ putChunksExp
 
 entityTagDecl ∷ ETag → [Decl]
-entityTagDecl eTag
+entityTagDecl tag
     = [ TypeSig (⊥) [varName] (TyCon (UnQual (name "ETag")))
       , nameBind (⊥) varName valExp
       ]
@@ -266,12 +266,13 @@ entityTagDecl eTag
       varName = name "entityTag"
 
       valExp ∷ Exp
-      valExp = function "parseETag" `app` strE (eTagToString eTag)
+      valExp = function "parseETag" `app` strE (eTagToString tag)
 
 lastModifiedDecl ∷ UTCTime → [Decl]
 lastModifiedDecl lastMod
     = [ TypeSig (⊥) [varName] (TyCon (UnQual (name "UTCTime")))
       , nameBind (⊥) varName valExp
+      , InlineSig (⊥) False AlwaysActive (UnQual varName)
       ]
     where
       varName ∷ Name
@@ -284,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
@@ -299,6 +301,7 @@ 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
@@ -313,7 +316,7 @@ dataDecl varName chunks
             strE (Strict.unpack chunk)
 
 mkHeader ∷ FilePath → Int64 → Int64 → Bool → MIMEType → ETag → UTCTime → IO String
-mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod
+mkHeader srcFile originalLen gzippedLen useGZip mType tag lastMod
     = do localLastMod ← utcToLocalZonedTime lastMod
          return $ concat
                     [ "{- DO NOT EDIT THIS FILE.\n"
@@ -330,8 +333,8 @@ mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod
                           "         Compression: gzip\n"
                       else
                           "         Compression: disabled\n"
-                    , "           MIME Type: ", mimeTypeToString mimeType, "\n"
-                    , "                ETag: ", eTagToString eTag, "\n"
+                    , "           MIME Type: ", mimeTypeToString mType, "\n"
+                    , "                ETag: ", eTagToString tag, "\n"
                     , "       Last Modified: ", show localLastMod, "\n"
                     , " -}"
                     ]
@@ -472,7 +475,7 @@ openOutput opts
         , resGet
             = Just $ do foundEntity entityTag lastModified
                         setContentType contentType
-                        output rawData
+                        putChunk rawData
         , resHead
             = Just $ do foundEntity entityTag lastModified
                         setContentType contentType
@@ -485,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..."
@@ -500,7 +506,7 @@ openOutput opts
   壓縮される場合は次のやうに變はる:
   ------------------------------------------------------------------------------
   -- import に追加
-  import Codec.Compression.GZip
+  import Codec.Compression.Zlib
 
   -- ResourceDef は次のやうに變化
   baz ∷ ResourceDef
@@ -514,9 +520,9 @@ openOutput opts
                         gzipAllowed ← isEncodingAcceptable "gzip"
                         if gzipAllowed then
                             do setContentEncoding ["gzip"]
-                               output gzippedData
+                               putChunks gzippedData
                         else
-                            output (decompress gzippedData)
+                            putChunks (decompress gzippedData)
         , resHead
             = Just $ do foundEntity entityTag lastModified
                         setContentType contentType
@@ -524,9 +530,10 @@ openOutput opts
         , resPut    = Nothing
         , resDelete = Nothing
         }
-  
+
   -- rawData の代はりに gzippedData
   gzippedData ∷ Lazy.ByteString
+  {-# NOINLINE gzippedData #-}
   gzippedData = Lazy.fromChunks
                 [ B64.decodeLenient "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQ..."
                 , B64.decodeLenient "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGA..."