combining static Yesod files. Also render a file with url interpolation just once.

Foundation.hs

onceUnsafe ∷ Trans.MonadIO m ⇒ m a → m a
onceUnsafe act =
  let var = unsafePerformIO $ liftIO $ newIORef Nothing
  in  onceIf (const True) var act 

onceInProductionUnsafe ∷ Trans.MonadIO m ⇒ m a → m a
onceInProductionUnsafe act =
  let var = unsafePerformIO $ liftIO $ newIORef Nothing
  in  onceIf (const production) var act 

onceIf ∷ Trans.MonadIO m ⇒ (a → Bool) → IORef (Maybe a) → m a → m a
onceIf predicate var act = do
    val ← liftIO $ readIORef var
    case val of
      Just set → return set
      Nothing → do
        res ← act
        when (predicate res) $ liftIO $ writeIORef var (Just res)
        return res 

-- | In production render this javascript file just once at startup.
-- Good for files with url interpolation and variable interpolation of constants known at startup
addStaticJs ∷ Yesod master ⇒ JavascriptUrl (Route master) → GHandler sub master Text
addStaticJs js = do
  renderUrl ← getUrlRenderParams
  let c = renderJavascriptUrl renderUrl js
  addedStatic ← addStaticContent "js" "text/javascript; charset=utf-8"
                $ encodeUtf8 c
  case addedStatic of
    Just (Right (u, p)) → return $ renderUrl u p
    _ → error "javascript not loaded"
      
addStaticText ∷ Yesod master ⇒ LT.Text → GHandler sub master Text
addStaticText c = do
  renderUrl ← getUrlRenderParams
  addedStatic ← addStaticContent "js" "text/javascript; charset=utf-8"
                $ encodeUtf8 c
  case addedStatic of
    Just (Right (u, p)) → return $ renderUrl u p
    _ -> error "javascript not loaded"

-- addCombinedScripts :: (Trans.MonadIO ((->) (JavascriptUrl (Route master))), Yesod master) => [Text.Julius.Javascript] -> JavascriptUrl (Route master) -> GHandler sub master Text
addCombinedScripts ∷ Yesod master ⇒ [Route Static] → GHandler sub master Text
addCombinedScripts scripts = 
  addStaticText ∘ combineScripts 
    =<< liftIO (mapM LTIO.readFile (map getFile scripts))
  where
    join ∷ (Monoid monoid) ⇒ monoid → [monoid] → monoid
    join joiner = foldl1 $ λmemo x → memo <> joiner <> x
    getFile (StaticRoute dirs _) = join "/" $ Settings.staticDir:(map T.unpack dirs)
    combineScripts ∷ [LT.Text] → LT.Text
    combineScripts = mconcat ∘ intersperse ";"


  defaultLayout widget = do
    y ← getYesod
    let combined = [ ... ]
    coffeeUrl ← onceInProductionUnsafe $ addStaticJs $(coffeeFile "search")

    mCombinedUrl ← if production
                      then fmap Just $ onceUnsafe $ addCombinedScripts combined
                      else return Nothing

    pc ← widgetToPageContent $ do
        widget
        case mCombinedUrl of
          Just combinedUrl → addScriptRemote combinedUrl
          Nothing → mapM_ (addScript ∘ StaticR) combined

        addScriptRemote coffeeUrl

there should be a ... before defaultLayout which is part of the foundation type