]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - ImplantFile.hs
RFC2231 is done... Hope it works...
[Lucu.git] / ImplantFile.hs
index ae749b9886c5a7422cd25bceb2137a83debb796f..fd57fadc456023ef5e78eee0b018098b12cada39 100644 (file)
@@ -1,9 +1,11 @@
-import           Codec.Binary.Base64
 import           Codec.Compression.GZip
 import           Control.Monad
 import           Data.Bits
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C8
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
-import qualified Data.ByteString.Lazy as L hiding (ByteString)
+import qualified Data.ByteString.Lazy as LS hiding (ByteString)
 import           Data.Char
 import           Data.Int
 import           Data.Maybe
@@ -78,11 +80,11 @@ main :: IO ()
 main = withOpenSSL $
        do (opts, sources, errors) <- return . getOpt Permute options =<< getArgs
 
-          when (not $ null errors)
+          unless (null errors)
                    $ do mapM_ putStr errors
                         exitWith $ ExitFailure 1
 
-          when (any (\ x -> x == OptHelp) opts)
+          when (any (== OptHelp) opts)
                    $ do printUsage
                         exitWith ExitSuccess
 
@@ -106,24 +108,24 @@ generateHaskellSource opts srcFile
          output   <- openOutput opts
          eTag     <- getETag opts input
 
-         let compParams  = defaultCompressParams { compressLevel = BestCompression }
+         let compParams  = defaultCompressParams { compressLevel = bestCompression }
              gzippedData = compressWith compParams input
-             originalLen = L.length input
-             gzippedLen  = L.length gzippedData
+             originalLen = LS.length input
+             gzippedLen  = LS.length gzippedData
              useGZip     = originalLen > gzippedLen
-             rawB64      = encode $ L.unpack input
-             gzippedB64  = encode $ L.unpack gzippedData
+             rawB64      = B64.encode $ BS.concat $ LS.toChunks input
+             gzippedB64  = B64.encode $ BS.concat $ LS.toChunks gzippedData
 
          header <- mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod
              
          let hsModule = HsModule undefined (Module modName) (Just exports) imports decls
              exports  = [HsEVar (UnQual (HsIdent symName))]
-             imports  = [ HsImportDecl undefined (Module "Codec.Binary.Base64")
-                                       False Nothing Nothing
+             imports  = [ HsImportDecl undefined (Module "Data.ByteString.Base64")
+                                       True (Just (Module "B64")) Nothing
+                        , HsImportDecl undefined (Module "Data.ByteString.Char8")
+                                       True (Just (Module "C8")) Nothing
                         , HsImportDecl undefined (Module "Data.ByteString.Lazy")
-                                       True (Just (Module "L")) Nothing
-                        , HsImportDecl undefined (Module "Data.Maybe")
-                                       False Nothing Nothing
+                                       True (Just (Module "LS")) Nothing
                         , HsImportDecl undefined (Module "Data.Time")
                                        False Nothing Nothing
                         , HsImportDecl undefined (Module "Network.HTTP.Lucu")
@@ -295,37 +297,35 @@ generateHaskellSource opts srcFile
              declGZippedData 
                  = [ HsTypeSig undefined [HsIdent "gzippedData"]
                                (HsQualType []
-                                (HsTyCon (Qual (Module "L") (HsIdent "ByteString"))))
+                                (HsTyCon (Qual (Module "LS") (HsIdent "ByteString"))))
                    , HsFunBind [HsMatch undefined (HsIdent "gzippedData")
                                 [] (HsUnGuardedRhs defGZippedData) []]
                    ]
 
              defGZippedData :: HsExp
              defGZippedData 
-                 = HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
-                   (HsParen
-                    (HsApp (HsVar (UnQual (HsIdent "fromJust")))
-                     (HsParen
-                      (HsApp (HsVar (UnQual (HsIdent "decode")))
-                       (HsLit (HsString gzippedB64))))))
+                 = HsApp (HsVar (Qual (Module "LS") (HsIdent "fromChunks")))
+                   (HsList [HsApp (HsVar (Qual (Module "B64") (HsIdent "decodeLenient")))
+                            (HsParen
+                             (HsApp (HsVar (Qual (Module "C8") (HsIdent "pack")))
+                              (HsLit (HsString $ C8.unpack gzippedB64))))])
 
              declRawData :: [HsDecl]
              declRawData 
                  = [ HsTypeSig undefined [HsIdent "rawData"]
                                (HsQualType []
-                                (HsTyCon (Qual (Module "L") (HsIdent "ByteString"))))
+                                (HsTyCon (Qual (Module "LS") (HsIdent "ByteString"))))
                    , HsFunBind [HsMatch undefined (HsIdent "rawData")
                                 [] (HsUnGuardedRhs defRawData) []]
                    ]
 
              defRawData :: HsExp
              defRawData
-                 = HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
-                   (HsParen
-                    (HsApp (HsVar (UnQual (HsIdent "fromJust")))
-                     (HsParen
-                      (HsApp (HsVar (UnQual (HsIdent "decode")))
-                       (HsLit (HsString rawB64))))))
+                 = HsApp (HsVar (Qual (Module "LS") (HsIdent "fromChunks")))
+                   (HsList [HsApp (HsVar (Qual (Module "B64") (HsIdent "decodeLenient")))
+                            (HsParen
+                             (HsApp (HsVar (Qual (Module "C8") (HsIdent "pack")))
+                              (HsLit (HsString $ C8.unpack rawB64))))])
 
          hPutStrLn output header
          hPutStrLn output (prettyPrint hsModule)
@@ -371,12 +371,12 @@ getSymbolName opts modName
                                             _            -> False) opts
           -- モジュール名をピリオドで分割した時の最後の項目の先頭文字を
           -- 小文字にしたものを使ふ。
-          defaultSymName = mkDefault modName
-          mkDefault      = headToLower . getLastComp
-          headToLower    = \ str -> case str of
-                                      []     -> error "module name must not be empty"
-                                      (x:xs) -> toLower x : xs
-          getLastComp    = reverse . fst . break (== '.') . reverse
+          defaultSymName  = mkDefault modName
+          mkDefault       = headToLower . getLastComp
+          headToLower str = case str of
+                              []     -> error "module name must not be empty"
+                              (x:xs) -> toLower x : xs
+          getLastComp     = reverse . fst . break (== '.') . reverse
       in
         case symNameOpts of
           []                      -> return defaultSymName
@@ -400,8 +400,8 @@ getMIMEType opts srcFile
 
 getLastModified :: FilePath -> IO UTCTime
 getLastModified "-"   = getCurrentTime
-getLastModified fpath = getFileStatus fpath
-                        >>= return . posixSecondsToUTCTime . fromRational . toRational . modificationTime
+getLastModified fpath = fmap (posixSecondsToUTCTime . fromRational . toRational . modificationTime)
+                        $ getFileStatus fpath
 
 
 getETag :: [CmdOpt] -> Lazy.ByteString -> IO String
@@ -411,31 +411,32 @@ getETag opts input
                                       _         -> False) opts
       in
         case eTagOpts of
-          []               -> getDigestByName "SHA1" >>= return . mkETagFromInput . fromJust
+          []               -> fmap (mkETagFromInput . fromJust) (getDigestByName "SHA1")
           (OptETag str):[] -> return str
           _                -> error "too many --etag options."
     where
       mkETagFromInput :: Digest -> String
-      mkETagFromInput sha1 = "SHA-1:" ++ (toHex $ digestLBS sha1 input)
+      mkETagFromInput sha1 = "SHA-1:" ++ toHex (digestLBS sha1 input)
 
-      toHex :: [Char] -> String
-      toHex []     = ""
-      toHex (x:xs) = hexByte (fromEnum x) ++ toHex xs
+      toHex :: String -> String
+      toHex = foldr ((++) . hexByte . fromEnum) ""
 
       hexByte :: Int -> String
       hexByte n
-          = hex4bit ((n `shiftR` 4) .&. 0x0F) : hex4bit (n .&. 0x0F) : []
+          = [ hex4bit ((n `shiftR` 4) .&. 0x0F)
+            , hex4bit ( n             .&. 0x0F)
+            ]
 
       hex4bit :: Int -> Char
       hex4bit n
-          | n < 10    = (chr $ ord '0' + n     )
-          | n < 16    = (chr $ ord 'a' + n - 10)
+          | n < 10    = chr $ ord '0' + n
+          | n < 16    = chr $ ord 'a' + n - 10
           | otherwise = undefined
 
 
 openInput :: FilePath -> IO Lazy.ByteString
-openInput "-"   = L.getContents
-openInput fpath = L.readFile fpath
+openInput "-"   = LS.getContents
+openInput fpath = LS.readFile fpath
 
 
 openOutput :: [CmdOpt] -> IO Handle
@@ -465,9 +466,9 @@ openOutput opts
          Last Modified: 2007-11-05 13:53:42.231882 JST
    -}
   module Foo.Bar.Baz (baz) where
-  import Codec.Binary.Base64
-  import qualified Data.ByteString.Lazy as L
-  import Data.Maybe
+  import qualified Data.ByteString.Base64 as B64
+  import qualified Data.ByteString.Char8 as C8
+  import qualified Data.ByteString.Lazy as LS
   import Data.Time
   import Network.HTTP.Lucu
 
@@ -494,8 +495,8 @@ openOutput opts
   contentType :: MIMEType
   contentType = read "image/png"
 
-  rawData :: L.ByteString
-  rawData = L.pack (fromJust (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ..."))
+  rawData :: LS.ByteString
+  rawData = LS.fromChunks [B64.decodeLenient (C8.pack "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...")]
   ------------------------------------------------------------------------------
 
   壓縮される場合は次のやうに變はる:
@@ -526,7 +527,7 @@ openOutput opts
         }
   
   -- rawData の代はりに gzippedData
-  gzippedData :: L.ByteString
-  gzippedData = L.pack (fromJust (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB..."))
+  gzippedData :: LS.ByteString
+  gzippedData = LS.fromChunks [B64.decodeLenient (C8.pack "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...")]
   ------------------------------------------------------------------------------
  -}