diff options
| -rw-r--r-- | Alpha.hs | 3 | ||||
| -rw-r--r-- | Biz/Bild.hs | 81 | ||||
| -rw-r--r-- | Biz/Bild/ShellHook.sh | 10 | ||||
| -rw-r--r-- | Biz/Dev.md | 10 | ||||
| -rw-r--r-- | Biz/Dev.nix | 4 | ||||
| -rw-r--r-- | Biz/Devalloc/Host.hs (renamed from Devalloc/Host.hs) | 11 | ||||
| -rw-r--r-- | Biz/Devalloc/Host.nix (renamed from Devalloc/Host.nix) | 0 | ||||
| -rw-r--r-- | Biz/Devalloc/Page/Home.hs (renamed from Devalloc/Page/Home.hs) | 2 | ||||
| -rw-r--r-- | Biz/Devalloc/Page/Signup.hs (renamed from Devalloc/Page/Signup.hs) | 2 | ||||
| -rwxr-xr-x | Biz/Devalloc/main.py (renamed from Devalloc/main.py) | 8 | ||||
| -rw-r--r-- | Biz/Devalloc/pitch.md (renamed from Devalloc/pitch.md) | 0 | ||||
| -rwxr-xr-x | Biz/Lint.py | 7 | ||||
| -rw-r--r-- | Biz/Que/Apidocs.md (renamed from Que/Apidocs.md) | 0 | ||||
| -rwxr-xr-x | Biz/Que/Client.py (renamed from Que/Client.py) | 0 | ||||
| -rw-r--r-- | Biz/Que/Host.hs (renamed from Que/Host.hs) | 63 | ||||
| -rw-r--r-- | Biz/Que/Host.nix (renamed from Que/Host.nix) | 0 | ||||
| -rw-r--r-- | Biz/Que/Index.md (renamed from Que/Index.md) | 0 | ||||
| -rw-r--r-- | Biz/Que/Prod.nix (renamed from Que/Prod.nix) | 6 | ||||
| -rw-r--r-- | Biz/Que/Quescripts.md (renamed from Que/Quescripts.md) | 0 | ||||
| -rw-r--r-- | Biz/Que/Site.hs (renamed from Que/Site.hs) | 70 | ||||
| -rw-r--r-- | Biz/Que/Site.nix (renamed from Que/Site.nix) | 0 | ||||
| -rw-r--r-- | Biz/Que/Style.css (renamed from Que/Style.css) | 0 | ||||
| -rw-r--r-- | Biz/Que/Tutorial.md (renamed from Que/Tutorial.md) | 0 | ||||
| -rw-r--r-- | Hero/Look/Typography.hs | 29 |
24 files changed, 165 insertions, 141 deletions
@@ -42,6 +42,7 @@ module Alpha -- * String capitalize, + lowercase, -- * Data Validation require, @@ -119,6 +120,8 @@ capitalize :: String -> String capitalize [] = [] capitalize str = (Char.toUpper <| List.head str) : (Char.toLower </ List.tail str) +lowercase str = [Char.toLower c | c <- str] + require :: Text -> Maybe a -> a require _ (Just x) = x require s Nothing = panic <| s <> " not found" diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 2526395..81ab44f 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -133,13 +133,17 @@ main = Nothing -> Exit.die "usage: bild <target>" Just target -> analyze target >>= build -type Namespace = String +data Ext = Hs | Scm | Nix + deriving (Show) + +data Namespace = Namespace [String] Ext + deriving (Show) type Dep = String type Out = String -data Compiler = Ghc | Ghcjs | Guile | Nix +data Compiler = Ghc | Ghcjs | Guile | NixBuild deriving (Show) data Target = Target @@ -164,6 +168,12 @@ analyze s = do root <- Env.getEnv "BIZ_ROOT" cwd <- Dir.getCurrentDirectory let path = cwd </> s + namespace = + require "namespace" + <| path + |> reps root "" + |> List.stripPrefix "/" + >>= Regex.match metaNamespace case File.takeExtension path of ".hs" -> do content <- String.lines </ Prelude.readFile path @@ -171,25 +181,15 @@ analyze s = do let compiler = if ".js" `List.isSuffixOf` out then Ghcjs else Ghc return Target - { namespace = - require "namespace" - <| path - |> reps root "" - |> File.dropExtension - |> reps "/" "." - |> List.stripPrefix "." - >>= Regex.match metaNamespace, - deps = content /> Regex.match metaDep |> catMaybes, + { deps = content /> Regex.match metaDep |> catMaybes, builder = user <> "@localhost", .. } ".nix" -> return Target - { namespace = reps root "" path |> List.stripPrefix "/" |> require "namespace", - path = path, - deps = [], - compiler = Nix, + { deps = [], + compiler = NixBuild, out = "", builder = join @@ -198,17 +198,17 @@ analyze s = do "@dev.simatime.com?ssh-key=/home/", user, "/.ssh/id_rsa" - ] + ], + .. } ".scm" -> return Target - { namespace = reps root "" path |> List.stripPrefix "/" |> require "namespace", - path = path, - deps = [], + { deps = [], compiler = Guile, out = "", - builder = user <> "@localhost" + builder = user <> "@localhost", + .. } e -> panic <| "bild does not know this extension: " <> Text.pack e @@ -217,7 +217,7 @@ build target@Target {..} = do root <- Env.getEnv "BIZ_ROOT" case compiler of Ghc -> do - putText <| "bild: dev: ghc: " <> Text.pack namespace + putText <| "bild: dev: ghc: " <> nsToPath namespace let outDir = root </> "_/bild/dev/bin" Dir.createDirectoryIfMissing True outDir putText <| "bild: dev: local: " <> Text.pack builder @@ -232,12 +232,12 @@ build target@Target {..} = do "--make", path, "-main-is", - namespace, + nsToHaskellModule namespace, "-o", outDir </> out ] Ghcjs -> do - putText <| "bild: dev: ghcjs: " <> Text.pack namespace + putText <| "bild: dev: ghcjs: " <> nsToPath namespace let outDir = root </> "_/bild/dev/static" Dir.createDirectoryIfMissing True outDir putText <| "bild: dev: local: " <> Text.pack builder @@ -252,19 +252,17 @@ build target@Target {..} = do "--make", path, "-main-is", - namespace, + nsToHaskellModule namespace, "-o", outDir </> out ] Guile -> do - putText <| "bild: dev: guile: " <> Text.pack namespace - let outDir = root </> "_/bild/dev/bin" - Dir.createDirectoryIfMissing True outDir + putText <| "bild: dev: guile: " <> nsToPath namespace putText <| "bild: dev: local: " <> Text.pack builder putText "bild: guile TODO" putText <| show target - Nix -> do - putText <| "bild: nix: " <> Text.pack namespace + NixBuild -> do + putText <| "bild: nix: " <> nsToPath namespace let outDir = root </> "_/bild/nix" Dir.createDirectoryIfMissing True outDir putText <| "bild: nix: remote: " <> Text.pack builder @@ -272,7 +270,7 @@ build target@Target {..} = do "nix-build" [ path, "-o", - outDir </> namespace, + outDir </> (Text.unpack <| nsToPath namespace), -- Set default arguments to nix functions "--arg", "bild", @@ -290,10 +288,29 @@ build target@Target {..} = do builder ] +nsToHaskellModule :: Namespace -> String +nsToHaskellModule (Namespace parts Hs) = joinWith "." parts +nsToHaskellModule (Namespace _ ext) = + panic <| "can't convert " <> show ext <> " to a Haskell module" + +nsToPath :: Namespace -> Text +nsToPath (Namespace parts ext) = + Text.pack + <| joinWith "/" parts + <> "." + <> lowercase (show ext) + metaNamespace :: Regex.RE Char Namespace -metaNamespace = name <> Regex.many (Regex.sym '.') <> name +metaNamespace = Namespace </ path <* Regex.sym '.' <*> ext where - name = Regex.many (Regex.psym Char.isUpper) <> Regex.many (Regex.psym Char.isLower) + name = + Regex.many (Regex.psym Char.isUpper) + <> Regex.many (Regex.psym Char.isLower) + path = Regex.many (name <* Regex.string "/" <|> name) + ext = + Nix <$ Regex.string "nix" + <|> Hs <$ Regex.string "hs" + <|> Scm <$ Regex.string "scm" metaDep :: Regex.RE Char Dep metaDep = Regex.string "-- : dep " *> Regex.many (Regex.psym Char.isAlpha) diff --git a/Biz/Bild/ShellHook.sh b/Biz/Bild/ShellHook.sh index b79f1a6..65c3f10 100644 --- a/Biz/Bild/ShellHook.sh +++ b/Biz/Bild/ShellHook.sh @@ -101,22 +101,24 @@ function ship() { # Poor man's ci function ci() { + set -e lint stuff=( Biz/Pie.hs Biz/Pie.nix + Biz/Devalloc/Host.hs + Biz/Que/Site.hs + Biz/Que/Host.hs + Biz/Que/Prod.nix Biz/Cloud.nix Biz/Dev.nix - Que/Site.hs - Que/Host.hs - Que/Prod.nix Hero/Host.hs Hero/Node.hs Hero/Prod.nix ) for thing in ${stuff[@]} do - bild $thing + bild "$thing" done } @@ -30,9 +30,10 @@ Then run `help` to see the dev commands. # Repository organization The source tree maps to the module namespace, and roughly follows the -Haskell namespace hierarchy (although nothing is enforced). The main -'common' space is `Biz`, other namespaces should be related to their -application. +Haskell namespace hierarchy (although nothing is enforced). The root namespace +for all code that we own is `Biz`; proprietary applications, products, and +infrastructure lives under there. Stuff that can be open sourced or otherwise +externalized should be outside of `Biz`. Development aspects should be localized to their sub-namespaces as much as possible. Only after sufficient iteration such that interfaces are @@ -44,9 +45,6 @@ well-defined. Likewise, the functionality and purpose of a particular namespace should be small and well-defined. Following the unix principle of "do one thing and do it well" is advised. -For building the code, we use `nix` and basically copy the namespace -hierarchy into the main build file `./default.nix`. - Namespaces are always capitalized. I would prefer always lowercase, but `ghc` _really_ wants capitalized files, so we appeas `ghc`. In Scheme this actually translates quite well and helps distinguish between types diff --git a/Biz/Dev.nix b/Biz/Dev.nix index cdb3036..d9f2cb6 100644 --- a/Biz/Dev.nix +++ b/Biz/Dev.nix @@ -9,14 +9,14 @@ bild.os { ./Users.nix ./Dev/Configuration.nix ./Dev/Hardware.nix - ../Devalloc/Host.nix + ./Devalloc/Host.nix ]; networking.hostName = "lithium"; networking.domain = "dev.simatime.com"; services.devalloc-host = { enable = true; port = 8095; - package = bild.ghc ../Devalloc/Host.hs; + package = bild.ghc ./Devalloc/Host.hs; }; } diff --git a/Devalloc/Host.hs b/Biz/Devalloc/Host.hs index 6d66f32..5a9ff80 100644 --- a/Devalloc/Host.hs +++ b/Biz/Devalloc/Host.hs @@ -19,19 +19,20 @@ -- : dep servant -- : dep servant-server -- : dep warp -module Devalloc.Host +module Biz.Devalloc.Host ( main, ) where import Alpha import Biz.App (CSS (..), HtmlApp (..)) -import qualified Biz.Look -- import qualified CMark as Cmark + +import qualified Biz.Devalloc.Page.Home as Home +import qualified Biz.Devalloc.Page.Signup as Signup +import qualified Biz.Look import qualified Clay import qualified Control.Exception as Exception -import qualified Devalloc.Page.Home as Home -import qualified Devalloc.Page.Signup as Signup import qualified Lucid import qualified Lucid.Base as Lucid import Miso hiding (node) @@ -106,7 +107,7 @@ instance Envy.DefConfig Config where defConfig = Config { port = 3000, - pitches = "./Devalloc/pitch.md", + pitches = "./Biz/Devalloc/pitch.md", node = "_/bild/dev/Devalloc.Node/static" } diff --git a/Devalloc/Host.nix b/Biz/Devalloc/Host.nix index 51aa85d..51aa85d 100644 --- a/Devalloc/Host.nix +++ b/Biz/Devalloc/Host.nix diff --git a/Devalloc/Page/Home.hs b/Biz/Devalloc/Page/Home.hs index f183881..9e90e70 100644 --- a/Devalloc/Page/Home.hs +++ b/Biz/Devalloc/Page/Home.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} -module Devalloc.Page.Home +module Biz.Devalloc.Page.Home ( Move (..), Path, Form (..), diff --git a/Devalloc/Page/Signup.hs b/Biz/Devalloc/Page/Signup.hs index 4bcdeec..8debf53 100644 --- a/Devalloc/Page/Signup.hs +++ b/Biz/Devalloc/Page/Signup.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} -module Devalloc.Page.Signup +module Biz.Devalloc.Page.Signup ( Move (..), Path, Form (..), diff --git a/Devalloc/main.py b/Biz/Devalloc/main.py index 280b1b8..bb10441 100755 --- a/Devalloc/main.py +++ b/Biz/Devalloc/main.py @@ -119,6 +119,7 @@ def guard_git(repo): def staleness(path, now): + "How long has it been since this file was touched?" timestamp = datetime.datetime.strptime( subprocess.check_output(["git", "log", "-n1", "--pretty=%aI", path]) .decode("utf-8") @@ -126,10 +127,7 @@ def staleness(path, now): "%Y-%m-%dT%H:%M:%S%z", ) delta = now - timestamp - if delta.days > 180: - return delta.days - else: - return None + return delta.days class Repo: @@ -157,7 +155,7 @@ class Repo: self.stale = {} for path, _ in self.stats.items(): _staleness = staleness(path, now) - if _staleness: + if _staleness > 180: self.stale[path] = _staleness def print_blackholes(self, full): diff --git a/Devalloc/pitch.md b/Biz/Devalloc/pitch.md index cfc0b23..cfc0b23 100644 --- a/Devalloc/pitch.md +++ b/Biz/Devalloc/pitch.md diff --git a/Biz/Lint.py b/Biz/Lint.py index fccda57..fc035cb 100755 --- a/Biz/Lint.py +++ b/Biz/Lint.py @@ -26,7 +26,7 @@ def run(cmd, file): "ormolu": ["--mode", "check"], "hlint": [], "black": ["--quiet", "--check"], - "pylint": [], + "pylint": ["--disable=invalid-name"], } # pylint: disable=subprocess-run-check ret = subprocess.run([cmd, *args[cmd], file], stdout=subprocess.PIPE) @@ -69,6 +69,8 @@ def group_files(files, extensions): def guard_todos(files): + "Fail if TODO found in text" + global ERRORS # pylint: disable=global-statement for fname in files: with open(fname) as text: if "TODO" in text.read(): @@ -92,6 +94,7 @@ if __name__ == "__main__": run("hlint", hs) for py in FILES[".py"]: print(f"lint: {py}") - run("black", py) + # Broken in our nixpkgs + # run("black", py) run("pylint", py) sys.exit(ERRORS) diff --git a/Que/Apidocs.md b/Biz/Que/Apidocs.md index f400889..f400889 100644 --- a/Que/Apidocs.md +++ b/Biz/Que/Apidocs.md diff --git a/Que/Client.py b/Biz/Que/Client.py index 1063eb8..1063eb8 100755 --- a/Que/Client.py +++ b/Biz/Que/Client.py diff --git a/Que/Host.hs b/Biz/Que/Host.hs index b8e7a1a..4817fd6 100644 --- a/Que/Host.hs +++ b/Biz/Que/Host.hs @@ -20,7 +20,7 @@ -- : dep stm -- : dep unagi-chan -- : dep unordered-containers -module Que.Host +module Biz.Que.Host ( main, ) where @@ -52,22 +52,22 @@ import qualified Prelude main :: IO () main = Exception.bracket startup shutdown <| uncurry Warp.run where - startup = Envy.decodeWithDefaults Envy.defConfig >>= \c -> do - sync <- STM.newTVarIO initialAppState - let runActionToIO m = runReaderT (runApp m) sync - waiapp <- Scotty.scottyAppT runActionToIO <| routes c - putText "*" - putText "Que.Host" - putText <| "port: " <> (show <| quePort c) - putText <| "skey: " <> (show <| queSkey c) - return (quePort c, waiapp) + startup = + Envy.decodeWithDefaults Envy.defConfig >>= \c -> do + sync <- STM.newTVarIO initialAppState + let runActionToIO m = runReaderT (runApp m) sync + waiapp <- Scotty.scottyAppT runActionToIO <| routes c + putText "*" + putText "Que.Host" + putText <| "port: " <> (show <| quePort c) + putText <| "skey: " <> (show <| queSkey c) + return (quePort c, waiapp) shutdown :: a -> IO a shutdown = pure . identity -newtype App a - = App - { runApp :: ReaderT (STM.TVar AppState) IO a - } +newtype App a = App + { runApp :: ReaderT (STM.TVar AppState) IO a + } deriving ( Applicative, Functor, @@ -77,21 +77,19 @@ newtype App a (STM.TVar AppState) ) -newtype AppState - = AppState - { ques :: HashMap Namespace Quebase - } +newtype AppState = AppState + { ques :: HashMap Namespace Quebase + } initialAppState :: AppState initialAppState = AppState {ques = mempty} -data Config - = Config - { -- | QUE_PORT - quePort :: Warp.Port, - -- | QUE_SKEY - queSkey :: FilePath - } +data Config = Config + { -- | QUE_PORT + quePort :: Warp.Port, + -- | QUE_SKEY + queSkey :: FilePath + } deriving (Generic, Show) instance Envy.DefConfig Config where @@ -162,13 +160,14 @@ routes cfg = do -- | Given `guardNs ns whitelist`, if `ns` is not in the `whitelist` -- list, return a 405 error. guardNs :: Text.Lazy.Text -> [Text.Lazy.Text] -> Scotty.ActionT Text.Lazy.Text App () -guardNs ns whitelist = when (not <| ns `elem` whitelist) <| do - Scotty.status Http.methodNotAllowed405 - Scotty.text - <| "not allowed: use 'pub' namespace or signup to protect '" - <> ns - <> "' at https://que.run" - Scotty.finish +guardNs ns whitelist = + when (not <| ns `elem` whitelist) <| do + Scotty.status Http.methodNotAllowed405 + Scotty.text + <| "not allowed: use 'pub' namespace or signup to protect '" + <> ns + <> "' at https://que.run" + Scotty.finish -- | recover from a scotty-thrown exception. (!:) :: diff --git a/Que/Host.nix b/Biz/Que/Host.nix index e326483..e326483 100644 --- a/Que/Host.nix +++ b/Biz/Que/Host.nix diff --git a/Que/Index.md b/Biz/Que/Index.md index a9db12e..a9db12e 100644 --- a/Que/Index.md +++ b/Biz/Que/Index.md diff --git a/Que/Prod.nix b/Biz/Que/Prod.nix index b755d7c..12da1eb 100644 --- a/Que/Prod.nix +++ b/Biz/Que/Prod.nix @@ -4,9 +4,9 @@ bild.os { imports = [ - ../Biz/OsBase.nix - ../Biz/Packages.nix - ../Biz/Users.nix + ../OsBase.nix + ../Packages.nix + ../Users.nix ./Host.nix ./Site.nix ]; diff --git a/Que/Quescripts.md b/Biz/Que/Quescripts.md index 77e7004..77e7004 100644 --- a/Que/Quescripts.md +++ b/Biz/Que/Quescripts.md diff --git a/Que/Site.hs b/Biz/Que/Site.hs index 5d2dbb8..99486a4 100644 --- a/Que/Site.hs +++ b/Biz/Que/Site.hs @@ -12,7 +12,7 @@ -- : dep process -- : dep protolude -- : dep req -module Que.Site +module Biz.Que.Site ( main, ) where @@ -33,10 +33,11 @@ import qualified System.Process as Process main :: IO () main = do - (src, ns) <- Environment.getArgs >>= \case - [src] -> return (src, "_") -- default to _ ns which is special - [src, ns] -> return (src, Text.pack ns) - _ -> Exit.die "usage: que-website <srcdir> [namespace]" + (src, ns) <- + Environment.getArgs >>= \case + [src] -> return (src, "_") -- default to _ ns which is special + [src, ns] -> return (src, Text.pack ns) + _ -> Exit.die "usage: que-website <srcdir> [namespace]" mKey <- getKey ns putText <| "serving " <> Text.pack src <> " at " <> ns run mKey ns @@ -65,15 +66,14 @@ getKey ns = do errorParsingConf :: error errorParsingConf = panic "could not parse ~/.config/que.conf" -data Sources - = Sources - { index :: FilePath, - quescripts :: FilePath, - client :: FilePath, - style :: FilePath, - tutorial :: FilePath, - apidocs :: FilePath - } +data Sources = Sources + { index :: FilePath, + quescripts :: FilePath, + client :: FilePath, + style :: FilePath, + tutorial :: FilePath, + apidocs :: FilePath + } type Namespace = Text @@ -112,24 +112,26 @@ run key ns Sources {..} = Async.runConcurrently actions |> void [] serve :: Maybe Key -> Namespace -> Text -> ByteString -> IO () -serve Nothing "pub" path content = runReq defaultHttpConfig <| do - _ <- - req - POST - (http "que.run" /: "pub" /: path) - (ReqBodyBs content) - ignoreResponse - mempty - liftIO <| return () +serve Nothing "pub" path content = + runReq defaultHttpConfig <| do + _ <- + req + POST + (http "que.run" /: "pub" /: path) + (ReqBodyBs content) + ignoreResponse + mempty + liftIO <| return () serve Nothing p _ _ = panic <| "no auth key provided for ns: " <> p -serve (Just key) ns path content = runReq defaultHttpConfig <| do - let options = - header "Authorization" (encodeUtf8 key) <> responseTimeout maxBound - _ <- - req - POST - (http "que.run" /: ns /: path) - (ReqBodyBs content) - ignoreResponse - options - liftIO <| return () +serve (Just key) ns path content = + runReq defaultHttpConfig <| do + let options = + header "Authorization" (encodeUtf8 key) <> responseTimeout maxBound + _ <- + req + POST + (http "que.run" /: ns /: path) + (ReqBodyBs content) + ignoreResponse + options + liftIO <| return () diff --git a/Que/Site.nix b/Biz/Que/Site.nix index ba2eeb2..ba2eeb2 100644 --- a/Que/Site.nix +++ b/Biz/Que/Site.nix diff --git a/Que/Style.css b/Biz/Que/Style.css index f8d1ca4..f8d1ca4 100644 --- a/Que/Style.css +++ b/Biz/Que/Style.css diff --git a/Que/Tutorial.md b/Biz/Que/Tutorial.md index 6542ad3..6542ad3 100644 --- a/Que/Tutorial.md +++ b/Biz/Que/Tutorial.md diff --git a/Hero/Look/Typography.hs b/Hero/Look/Typography.hs index 9e35ef5..7c28f21 100644 --- a/Hero/Look/Typography.hs +++ b/Hero/Look/Typography.hs @@ -36,7 +36,7 @@ lean = fontStyle italic -- | "smallcaps" is already taken by Clay smol = fontVariant smallCaps -lower = textTransform lowercase +lower = textTransform Clay.lowercase upper = textTransform uppercase @@ -52,21 +52,22 @@ fontRoot = Pack.cdnEdge <> "/old-assets/fonts/eurostile/Eurostile" -- | font faces fonts :: Css fonts = - mconcat <| - mkEuro - </ [ ("-Reg.otf", OpenType, fontWeight normal <> fontStyle normal), - ("LTStd-Bold.otf", OpenType, thicc <> norm), - ("LTStd-Cn.otf", OpenType, slim <> norm), - ("LTStd-Ex2.otf", OpenType, wide <> norm), - ("LTStd-BoldCn.otf", OpenType, slim <> thicc), - ("LTStd-BoldEx2.otf", OpenType, wide <> thicc) - ] + mconcat + <| mkEuro + </ [ ("-Reg.otf", OpenType, fontWeight normal <> fontStyle normal), + ("LTStd-Bold.otf", OpenType, thicc <> norm), + ("LTStd-Cn.otf", OpenType, slim <> norm), + ("LTStd-Ex2.otf", OpenType, wide <> norm), + ("LTStd-BoldCn.otf", OpenType, slim <> thicc), + ("LTStd-BoldEx2.otf", OpenType, wide <> thicc) + ] where mkEuro :: (Text, FontFaceFormat, Css) -> Css - mkEuro (sufx, fmt, extra) = fontFace <| do - fontFamily ["Eurostile"] [] - fontFaceSrc [FontFaceSrcUrl (fontRoot <> sufx) <| Just fmt] - extra + mkEuro (sufx, fmt, extra) = + fontFace <| do + fontFamily ["Eurostile"] [] + fontFaceSrc [FontFaceSrcUrl (fontRoot <> sufx) <| Just fmt] + extra -- TODO: add the below to Clay.Font upstream |