X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=ImplantFile.hs;h=b085a9876b859c4463c11609524da25082b48f4d;hb=ac2ff93;hp=0e91f1c6bdbb7bd2b5667d68790325ad5ad88a95;hpb=558205096e7f51da7018458d173584ac31808082;p=Lucu.git diff --git a/ImplantFile.hs b/ImplantFile.hs index 0e91f1c..b085a98 100644 --- a/ImplantFile.hs +++ b/ImplantFile.hs @@ -159,12 +159,10 @@ mkImports useGZip False False Nothing Nothing Nothing ] ⧺ - if useGZip then - [ ImportDecl (⊥) (ModuleName "Codec.Compression.GZip") - False False Nothing Nothing Nothing - ] - else - [] + [ ImportDecl (⊥) (ModuleName "Codec.Compression.GZip") + False False Nothing Nothing Nothing + | useGZip + ] resourceDecl ∷ Name → Bool → [Decl] resourceDecl symName useGZip @@ -184,21 +182,19 @@ resourceDecl symName useGZip resHead ∷ Exp resHead - = infixApp (var $ name "Just") - (op $ name "$" ) - (doE [ foundEntityStmt - , setContentTypeStmt - ]) + = function "Just" `app` + paren (doE [ foundEntityStmt + , setContentTypeStmt + ]) resGetGZipped ∷ Exp resGetGZipped - = infixApp (var $ name "Just") - (op $ name "$" ) - (doE [ foundEntityStmt - , setContentTypeStmt - , bindGZipStmt - , conditionalOutputStmt - ]) + = function "Just" `app` + paren (doE [ foundEntityStmt + , setContentTypeStmt + , bindGZipStmt + , conditionalOutputStmt + ]) where condVarName ∷ Name condVarName = name "gzipAllowed" @@ -210,7 +206,7 @@ resGetGZipped bindGZipStmt = genStmt (⊥) (pvar condVarName) - (metaFunction "isEncodingAcceptable" [strE "gzip"]) + (function "isEncodingAcceptable" `app` strE "gzip") conditionalOutputStmt ∷ Stmt conditionalOutputStmt @@ -219,42 +215,46 @@ resGetGZipped (doE [ setContentEncodingGZipStmt , outputStmt (var dataVarName) ]) - (metaFunction "output" - [paren (metaFunction "decompress" [var dataVarName])]) + ( function "output" + `app` + paren (function "decompress" `app` var dataVarName) + ) resGetRaw ∷ Exp resGetRaw - = infixApp (var $ name "Just") - (op $ name "$" ) - (doE [ foundEntityStmt - , setContentTypeStmt - , outputStmt (var $ name "rawData") - ]) + = function "Just" `app` + paren (doE [ foundEntityStmt + , setContentTypeStmt + , outputStmt (var $ name "rawData") + ]) setContentEncodingGZipStmt ∷ Stmt setContentEncodingGZipStmt - = qualStmt $ - metaFunction "setContentEncoding" $ - [ listE [ strE "gzip" ] ] + = qualStmt + ( function "setContentEncoding" + `app` + listE [ strE "gzip" ] + ) foundEntityStmt ∷ Stmt foundEntityStmt = qualStmt $ - metaFunction "foundEntity" $ - [ var $ name "entityTag" - , var $ name "lastModified" - ] + metaFunction "foundEntity" + [ var $ name "entityTag" + , var $ name "lastModified" + ] setContentTypeStmt ∷ Stmt setContentTypeStmt - = qualStmt $ - metaFunction "setContentType" $ - [var $ name "contentType"] + = qualStmt + ( function "setContentType" + `app` + var (name "contentType") + ) outputStmt ∷ Exp → Stmt outputStmt e - = qualStmt $ - metaFunction "output" [e] + = qualStmt $ function "output" `app` e entityTagDecl ∷ ETag → [Decl] entityTagDecl eTag @@ -266,7 +266,7 @@ entityTagDecl eTag varName = name "entityTag" valExp ∷ Exp - valExp = metaFunction "parseETag" [strE $ eTagToString eTag] + valExp = function "parseETag" `app` strE (eTagToString eTag) lastModifiedDecl ∷ UTCTime → [Decl] lastModifiedDecl lastMod @@ -278,7 +278,7 @@ lastModifiedDecl lastMod varName = name "lastModified" valExp ∷ Exp - valExp = metaFunction "read" [strE $ show lastMod] + valExp = function "read" `app` strE (show lastMod) contentTypeDecl ∷ MIMEType → [Decl] contentTypeDecl mime @@ -290,7 +290,7 @@ contentTypeDecl mime varName = name "contentType" valExp ∷ Exp - valExp = metaFunction "parseMIMEType" [strE $ mimeToString mime] + valExp = function "parseMIMEType" `app` strE (mimeToString mime) mimeToString ∷ MIMEType → String mimeToString = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType @@ -330,7 +330,7 @@ mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod " Compression: gzip\n" else " Compression: disabled\n" - , " MIME Type: ", show mimeType, "\n" + , " MIME Type: ", mimeTypeToString mimeType, "\n" , " ETag: ", eTagToString eTag, "\n" , " Last Modified: ", show localLastMod, "\n" , " -}" @@ -339,12 +339,15 @@ mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod eTagToString ∷ ETag → String eTagToString = A.toString ∘ A.fromAsciiBuilder ∘ printETag +mimeTypeToString ∷ MIMEType → String +mimeTypeToString = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType + getModuleName ∷ [CmdOpt] → IO ModuleName getModuleName opts = case modNameOpts of - [] → fail "a module name must be given." - (OptModName modName):[] → return $ ModuleName modName - _ → fail "too many --module options." + [] → fail "a module name must be given." + OptModName modName:[] → return $ ModuleName modName + _ → fail "too many --module options." where modNameOpts ∷ [CmdOpt] modNameOpts = filter (\ x → case x of @@ -354,9 +357,9 @@ getModuleName opts getSymbolName ∷ [CmdOpt] → ModuleName → IO Name getSymbolName opts (ModuleName modName) = case symNameOpts of - [] → return defaultSymName - (OptSymName symName):[] → return $ name symName - _ → fail "too many --symbol options." + [] → return defaultSymName + OptSymName symName:[] → return $ name symName + _ → fail "too many --symbol options." where symNameOpts ∷ [CmdOpt] symNameOpts = filter (\ x → case x of @@ -378,7 +381,7 @@ getMIMEType ∷ [CmdOpt] → FilePath → IO MIMEType getMIMEType opts srcFile = case mimeTypeOpts of [] → return defaultType - (OptMIMEType ty):[] + OptMIMEType ty:[] → case A.fromChars ty of Just a → return $ parseMIMEType a Nothing → fail "MIME type must not contain any non-ASCII letters." @@ -406,9 +409,9 @@ getLastModified fpath = (posixSecondsToUTCTime ∘ fromRational ∘ toRational getETag ∷ [CmdOpt] → Lazy.ByteString → IO ETag getETag opts input = case eTagOpts of - [] → return $ mkETagFromInput - (OptETag str):[] → return $ strToETag str - _ → fail "too many --etag options." + [] → return mkETagFromInput + OptETag str:[] → return $ strToETag str + _ → fail "too many --etag options." where eTagOpts ∷ [CmdOpt] eTagOpts = filter (\ x → case x of @@ -432,9 +435,9 @@ openInput fpath = Lazy.readFile fpath openOutput ∷ [CmdOpt] → IO Handle openOutput opts = case outputOpts of - [] → return stdout - (OptOutput fpath):[] → openFile fpath WriteMode - _ → fail "two many --output options." + [] → return stdout + OptOutput fpath:[] → openFile fpath WriteMode + _ → fail "two many --output options." where outputOpts ∷ [CmdOpt] outputOpts = filter (\ x → case x of