Bah, this was a horrible bug, and it's still open although I've made
significant progress in isolating it.
Indeed, the problem appears to be not with fileServe, but with a
HStringTemplate machinery handler
(which I wrote) packaged on hackage in HStringTemplateHandlers.
I have managed to create a test case for it, and integrated it into
the happstutorial code in darcs at
http://code.haskell.org/happs-tutorial. This online url (keep
refreshing) shows the buggy behavior:
http://happstutorial.com/static/Html2/index.html
There are 16 gifs total, usually at least one or two goes missing. (On
my development laptop
typically 12-14 gifs go missing, so at least partly a hardware/
environment issue?)
The bug comes down to 2 lines of code in Controller.hs. If these two
lines are commented out
and the server is restarted, Html2/index.html shows all 16 gifs as it
should.
The test case is in Controller.tutorial:
http://happstutorial.com/src/Controller.hs
" -- If the following two lines are commented out, (?) --
http:localhost:5001/static/Html2/index.html
-- shows all images correctly
tDirGroups <- liftIO $ directoryGroupsSafer $ "templates"
let ts = getTemplateGroup "." tDirGroups
"
To make debugging easier, I moved the directoryGroupSafer out of
hackaged library code and included it in the darcs distribution in
StringTemplateHelpers.hs:
http://happstutorial.com/src/StringTemplateHelpers.hs
I suspect a strict/lazy IO bug (mainly because lazy IO seems to be the
source of so many "weird" haskell bugs rather than any well-founded
reason) in the following functions, pasted below.
If anybody out there sees anything that seems that it could be a
culprit, please please share!
There is a workaround -- a couple actually.
1) I can get the template handlers in the main function and pass them
in as a pure value. That works, but it means I have to stop and
restart the server every time I want to make a change, which can take
up to a minute on my rinky-dink laptop unfortunately. (Perhaps time to
upgrade?)
2) I can simply use directoryGroupSafer (note no "s") rather than
directoryGroupsSafer.
This is ok since all the templates in happstutorial are grouped
into one top-level directory anyway.
However, in my other app (and eventually in happstutorial when I
get around to it) I found it a lot
easier to work with template groups when they were broken into
subdirectories, eg for header,
menu, various subcompartments with common functionality. So, I
really like directoryGroupsSafer
(with the s) and hope to keep using it. Unfortunately, at the
moment it appears that it is borked.
Well, that's about all I can think of to say on the subject. The lines
I suspect / hope have the bug are pasted below, but of course it might
be somewhere else. From StringTemplateHelpers, in darcs and linked
above:
directoryGroupsSafer d = bracketCD d $ do
subDirs <- findDirectories $ "."
-- attempt to make strict, but doesn't make
any difference
--putStrLn . show . last $ show
subDirs
return . M.fromList =<< mapM f
subDirs
where
f d = do g <- directoryGroupSafer d
return (d,g)
-- this seems suspect. Perhaps try using the find module on
hackage?
-- | wrapper over find \/path\/to\/top\/dir -type d
findDirectories :: FilePath -> IO [FilePath]
findDirectories d = runStrings $ render1 [("d",d)] "find $d$ -type
d"
where
runStrings :: String -> IO [String]
runStrings = ( return . lines =<< ) . run
-- | calculate the STGroup for a given directory, filtering out files
that are probably errors (eg emacs backups)
--directoryGroupSafer :: (Stringable a) => FilePath -> IO (STGroup a)
directoryGroupSafer :: FilePath -> IO (String -> StFirst
(StringTemplate String) )
directoryGroupSafer path = do
files <- mapM checkTmplName =<< return . filter isTemplateFile =<<
getDirectoryContents path
contents <- mapM readFile $ map (path </>) files
-- does this make it strict? what's the right way to do it?
-- mm, the buggy behavior persists, with or without putStrLn .
show . last
--putStrLn . show . last . show $ contents
let sts = map newSTMP contents
tnames = map dropExtension files
return $ groupStringTemplates $ zip tnames sts
where
checkTmplName t = if ( badTmplVarName . takeBaseName ) t
then fail $ "directoryGroupSafer, bad
template name: " ++ t
else return t
isTemplateFile f = ( (".st" ==) . takeExtension $ f )
&& (not . or . map (=='#') $ f ) {-filename doesn't
contain naughty emacs backup character-}
> PGP.sig
> < 1KViewDownload