Merge pull request #542 from yesodweb/no-string-packing

Revert string packing in yesod-static

yesod-static/Yesod/Static.hs

@@ -62,7 +62,6 @@ module Yesod.Static
 import Prelude hiding (FilePath)
 import qualified Prelude
 import System.Directory
-import Control.Arrow (second)
 import Control.Monad
 import Data.FileEmbed (embedDir)
 
@@ -83,11 +82,10 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.Serialize
 import Data.Text (Text, pack)
 import qualified Data.Text as T
-import qualified Data.Set as S
 import qualified Data.Map as M
 import Data.IORef (readIORef, newIORef, writeIORef)
 import Data.Char (isLower, isDigit)
-import Data.List (foldl', inits, tails)
+import Data.List (foldl')
 import qualified Data.ByteString as S
 import System.PosixCompat.Files (getFileStatus, modificationTime)
 import System.Posix.Types (EpochTime)
@@ -325,32 +323,14 @@ mkStaticFilesList
     -> Bool     -- ^ append checksum query parameter
     -> Q [Dec]
 mkStaticFilesList fp fs routeConName makeHash = do
-    let (squashedFinal, squashMap) = squashStrings ("etag" : concat fs)
+    concat `fmap` mapM mkRoute fs
-    (squashedName, squashedDecl) <- mkSquashedStringsDecl squashedFinal
-    let refName = mkSquashedReference squashedName squashMap
-    routes <- concat `fmap` mapM (mkRoute refName) fs
-    return (squashedDecl ++ routes)
   where
     replace' c
         | 'A' <= c && c <= 'Z' = c
         | 'a' <= c && c <= 'z' = c
         | '0' <= c && c <= '9' = c
         | otherwise = '_'
-    mkSquashedStringsDecl squashedFinal = do
+    mkRoute f = do
-      name  <- newName "squashedStrings"
-      pack' <- [|pack|]
-      squashedFinal' <- TH.lift squashedFinal
-      let decl = [ SigD name (ConT ''Text)
-                 , FunD name
-                     [ Clause [] (NormalB $ pack' `AppE` squashedFinal') []
-                     ]
-                 ]
-      return (name, decl)
-    mkSquashedReference squashedName squashMap = \str ->
-      case M.lookup str squashMap of
-        Nothing         -> [|pack $(TH.lift str)|]
-        Just (pos, len) -> [|T.take len (T.drop pos $(return (VarE squashedName)))|]
-    mkRoute refName f = do
         let name' = intercalate "_" $ map (map replace') f
             routeName = mkName $
                 case () of
@@ -359,11 +339,12 @@ mkStaticFilesList fp fs routeConName makeHash = do
                         | isDigit (head name') -> '_' : name'
                         | isLower (head name') -> name'
                         | otherwise -> '_' : name'
-        f' <- ListE `fmap` mapM refName f
+        f' <- [|map pack $(TH.lift f)|]
         let route = mkName routeConName
+        pack' <- [|pack|]
         qs <- if makeHash
                     then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f
-                            [|[($(refName "etag"), $(refName hash))]|]
+                            [|[(pack "etag", pack $(TH.lift hash))]|]
                     else return $ ListE []
         return
             [ SigD routeName $ ConT route
@@ -372,44 +353,6 @@ mkStaticFilesList fp fs routeConName makeHash = do
                 ]
             ]
 
-
--- | Convert a list of 'String's into a single 'String' and a
--- 'M.Map' of the original 'String's into an offset and a length on
--- the resulting single 'String'.
-squashStrings :: [String] -> (String, M.Map String (Int, Int))
-squashStrings = second M.fromAscList . go 0 "" . S.toAscList . S.fromList
-  where
-    -- Length of the string of maximal length of characters from
-    -- the end of the @lastString@ that are the same.  Uses a
-    -- naive algorithm.
-    calculateOverlap lastString newString =
-      let -- Make both strings of equal length.
-          len = length lastString `min` length newString
-          lastString' = reverse $ take len $ reverse lastString
-          newString'  =           take len           newString
-          -- Using 'head' should be safe but we use another
-          -- version to avoid unuseful messages while debugging.
-          safeHead (x:_) = x
-          safeHead []    = error "squashStrings/overlap: never here"
-      in safeHead $ do
-           (lastStringSuffix, newStringPrefix) <-
-             tails lastString' `zip` reverse (inits newString')
-           guard (lastStringSuffix == newStringPrefix)
-           return (length lastStringSuffix)
-
-    -- Position the new strings on the resulting string.
-    go lastPos lastString (newString:nss) =
-      let len     = length newString
-          overlap = calculateOverlap lastString newString
-          thisPos    = lastPos - overlap
-          newLastPos = lastPos + len - overlap
-          (recString, recMap) = go newLastPos newString nss
-      in ( drop overlap newString ++ recString
-         , (newString, (thisPos, len)) : recMap
-         )
-    go _ _ [] = ([], [])
-
-
 base64md5File :: Prelude.FilePath -> IO String
 base64md5File = fmap (base64 . encode) . hashFile
     where encode d = Data.Serialize.encode (d :: MD5)