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."
]
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)
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
= 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
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
lastModifiedDecl lastMod
= [ TypeSig (⊥) [varName] (TyCon (UnQual (name "UTCTime")))
, nameBind (⊥) varName valExp
+ , InlineSig (⊥) False AlwaysActive (UnQual varName)
]
where
varName ∷ Name
contentTypeDecl mime
= [ TypeSig (⊥) [varName] (TyCon (UnQual (name "MIMEType")))
, nameBind (⊥) varName valExp
+ , InlineSig (⊥) False AlwaysActive (UnQual varName)
]
where
varName ∷ Name
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
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..."
壓縮される場合は次のやうに變はる:
------------------------------------------------------------------------------
-- 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
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
, 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..."
projects / Lucu.git / blobdiff