Allow loading the SVG font from deployment data path

config/settings-default.yaml

@@ -38,6 +38,8 @@ ip-from-header: "_env:IP_FROM_HEADER:false"
 # mutable-static: false
 # skip-combining: false
 
+# load-font-from-lib-data: false
+
 ###############################################################################
 # SQL database
 ###############################################################################

src/Diagrams/IntransitiveDAG.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -39,7 +39,6 @@ import Diagrams.TwoD.Path (stroke)
 import Diagrams.TwoD.Shapes (roundedRect)
 import Diagrams.TwoD.Size (width)
 import Diagrams.Util ((#), with, applyAll)
-import Graphics.SVGFonts.Fonts (lin2)
 import Graphics.SVGFonts.Text (textSVG', TextOpts (..))
 --import Yesod.Core.Handler (toTextUrl)
 
@@ -81,18 +80,18 @@ box w h =
             # fc black
             # lc plain
 
-textBox n s u =
+textBox f n s u =
     let h = 1
-        t = href u $ stroke $ textSVG' with {textFont = lin2, textHeight = h} s
+        t = href u $ stroke $ textSVG' with {textFont = f, textHeight = h} s
         t' = t # lc plain
         w = width t'
         b = box w h
     in  named n $ t' `atop` b
 
 -- intransDag :: Graph g => g a b -> QDiagram
-intransDag disp link graph =
+intransDag font disp link graph =
     let ls = layers graph
         conn (n, _, cs) = map (\ c -> connectOutside c n) cs
         conns = concatMap (concatMap conn) ls
-        tbox (n, l, _) = textBox n (disp l) (link l)
+        tbox (n, l, _) = textBox font n (disp l) (link l)
     in  applyAll conns $ vcat $ map (hcat . map tbox) ls

src/Vervis/Application.hs

@@ -34,6 +34,8 @@ import Control.Concurrent (forkIO)
 import Control.Monad.Logger                 (liftLoc, runLoggingT, logInfo, logError)
 import Database.Persist.Postgresql          (createPostgresqlPool, pgConnStr,
                                              pgPoolSize, runSqlPool)
+import Graphics.SVGFonts.Fonts (lin2)
+import Graphics.SVGFonts.ReadFont (loadFont)
 import Vervis.Import
 import Language.Haskell.TH.Syntax           (qLocation)
 import Network.Wai (Middleware)
@@ -98,6 +100,11 @@ makeFoundation appSettings = do
             Nothing -> return Nothing
             Just _  -> Just <$> newChan
 
+    appSvgFont <-
+        if appLoadFontFromLibData appSettings
+            then return lin2
+            else loadFont "data/LinLibertineCut.svg"
+
     -- We need a log function to create a connection pool. We need a connection
     -- pool to create our foundation. And we need our foundation to get a
     -- logging function. To get out of this loop, we initially create a

src/Vervis/Foundation.hs

@@ -22,6 +22,7 @@ import Control.Monad.Trans.Maybe
 import Data.Time.Interval (fromTimeUnit)
 import Data.Time.Units (Day)
 import Database.Persist.Sql (ConnectionPool, runSqlPool)
+import Graphics.SVGFonts.ReadFont (PreparedFont)
 import Text.Shakespeare.Text (textFile)
 import Text.Hamlet          (hamletFile)
 --import Text.Jasmine         (minifym)
@@ -61,6 +62,7 @@ data App = App
     , appHttpManager :: Manager
     , appLogger      :: Logger
     , appMailQueue   :: Maybe (Chan (MailRecipe App))
+    , appSvgFont     :: PreparedFont Double
     }
 
 -- This is where we define all of the routes in our application. For a full

src/Vervis/Settings.hs

@@ -70,6 +70,10 @@ data AppSettings = AppSettings
       -- | Perform no stylesheet/script combining
     , appSkipCombining          :: Bool
 
+      -- | Load SVG font file from the data file path of the @SVGFonts@
+      -- library, instead of the app's production runtime data directory.
+    , appLoadFontFromLibData    :: Bool
+
       -- | Path to the directory under which git repos are placed
     , appRepoDir                :: FilePath
       -- | Number of context lines to display around changes in commit diff
@@ -108,6 +112,8 @@ instance FromJSON AppSettings where
         appMutableStatic          <- o .:? "mutable-static"   .!= defaultDev
         appSkipCombining          <- o .:? "skip-combining"   .!= defaultDev
 
+        appLoadFontFromLibData    <- o .:? "load-font-from-lib-data" .!= defaultDev
+
         appRepoDir                <- o .: "repo-dir"
         appDiffContextLines       <- o .: "diff-context-lines"
         appSshPort                <- o .: "ssh-port"

src/Vervis/Widget/Role.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -29,7 +29,7 @@ import Diagrams.TwoD.Size (mkWidth)
 import Graphics.Svg.Core (renderText)
 import Text.Blaze.Html (preEscapedToHtml)
 import Yesod.Core (Route)
-import Yesod.Core.Handler (getUrlRender)
+import Yesod.Core.Handler (getsYesod, getUrlRender)
 import Yesod.Core.Widget (toWidget)
 
 import qualified Data.Text as T (unpack)
@@ -46,8 +46,9 @@ roleGraph
     -> Widget
 roleGraph link shr g = do
     r <- getUrlRender
+    font <- getsYesod appSvgFont
     let dia :: Diagram SVG
-        dia = intransDag (T.unpack . rl2text) (T.unpack . r . link shr) g
+        dia = intransDag font (T.unpack . rl2text) (T.unpack . r . link shr) g
         opts = SVGOptions
             { _size            = mkWidth 480
             , _svgDefinitions  = Nothing