ditz issue: lucu-9

[Lucu.git] / ImplantFile.hs

diff --git a/ImplantFile.hs b/ImplantFile.hs
index 0e91f1c6bdbb7bd2b5667d68790325ad5ad88a95..b085a9876b859c4463c11609524da25082b48f4d 100644 (file)
--- 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