CLI


1 Main module

The CLI has two main parts: the use of the modules (libraries) that Lilac provides (the "functional core", if you will), and the boilerplate around that to interact with the real world (the "imperative shell").

The boilerplate involves option handling (where we use optparse-applicative) and injecting the Git version information into the version string.

module:Main
🎯 bin/Main.hs
module Main (main) where

import Control.Concurrent (forkIO)
import Control.Concurrent.STM
  ( newBroadcastTChanIO,
    newTVarIO,
  )
import Control.Exception (finally)
import Data.Aeson (ToJSON, eitherDecodeStrictText, encodeFile)
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.FileEmbed (embedFile)
import Data.Map.Strict qualified as M
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.UUID (UUID)
import Data.UUID.V4 (nextRandom)
import Data.Version (showVersion)
import Lilac.Compile qualified as LC
import Lilac.Parse qualified as LP
import Lilac.Serve (fsWatcher, liveReloadMiddleware)
import Lilac.Tangle qualified as LT
import Lilac.Types
  ( Archive (objects),
    ArchiveOpts (ArchiveOpts, inputs, outFile),
    Block (meta),
    Cell (CBlock),
    CompileOpts (CompileOpts, inputs),
    GPath,
    GlobalOpts
      ( GlobalOpts,
        color,
        projectConf,
        subcommand,
        verbose
      ),
    InitOpts (InitOpts, onlyLocalImports),
    LintOpts (LintOpts, inputs),
    Object (orgDoc),
    OrgDoc (cells),
    ProjectConf
      ( ProjectConf,
        bibliography,
        citationStyle,
        homepage,
        htmlHead,
        name,
        nonTangledPathspecs,
        repo,
        version
      ),
    RawProjectConf
      ( bibliography,
        citationStyle,
        homepage,
        htmlHead,
        name,
        nonTangledPathspecs,
        repo,
        version
      ),
    ServeOpts (ServeOpts, dir, port),
    Subcommand
      ( ComArchive,
        ComCompile,
        ComInit,
        ComLint,
        ComServe,
        ComTangle,
        ComWeave
      ),
    TangleOpts (TangleOpts, inputs, outDir),
    WeaveConf
      ( WeaveConf,
        archive,
        citeprocResult,
        originObjectPath,
        outDir,
        projectConf,
        rootRelativePrefix
      ),
    WeaveOpts
      ( WeaveOpts,
        inputs,
        outDir,
        rootRelativePrefix,
        writeCss,
        writeJs
      ),
    decodeGPath,
    defaultOrgParserState,
    encodeGPath,
  )
import Lilac.Util qualified as LU
import Lilac.Version (lilacVersion)
import Lilac.Weave qualified as LW
import Lilac.Weave.Css qualified as LWC
import Network.URI qualified as N
import Network.Wai.Application.Static (defaultFileServerSettings, staticApp)
import Network.Wai.Handler.Warp
  ( defaultSettings,
    runSettings,
    setPort,
  )
import Options.Applicative
  ( Parser,
    ReadM,
    argument,
    command,
    customExecParser,
    eitherReader,
    flag,
    fullDesc,
    header,
    help,
    helper,
    hsubparser,
    info,
    infoOption,
    long,
    metavar,
    option,
    prefs,
    progDesc,
    short,
    showDefault,
    showHelpOnEmpty,
    some,
    str,
    value,
  )
import Options.Applicative.Builder (InfoMod)
import Paths_lilac (version)
import Relude
  ( Bool (False, True),
    Either (Left, Right),
    FilePath,
    IO,
    Int,
    LByteString,
    Maybe (Just, Nothing),
    MonadFail,
    String,
    Text,
    Type,
    concat,
    concatMap,
    fail,
    fmap,
    foldlM,
    forM_,
    fromMaybe,
    intercalate,
    length,
    map,
    mapM,
    mapM_,
    mapMaybe,
    mempty,
    newEmptyMVar,
    newMVar,
    not,
    null,
    otherwise,
    pure,
    putLBS,
    putMVar,
    putStr,
    putStrLn,
    putTextLn,
    readMaybe,
    reverse,
    runStateT,
    sequence_,
    show,
    sort,
    takeMVar,
    when,
    ($),
    (&&),
    (+),
    (.),
    (/=),
    (<),
    (<$>),
    (<*>),
    (<>),
    (=<<),
    (==),
    (>),
    (||),
  )
import Relude.Extra.Map (lookup)
import System.Console.ANSI qualified as C
import System.Directory.OsPath qualified as D
import System.Exit (die, exitFailure)
import System.OsPath (OsPath)
import System.OsPath qualified as P
import System.Process.Typed (proc, readProcessStdout_)
import Text.Megaparsec qualified as MP
import Toml (decode)
import Toml.Schema
  ( Result (Failure, Success),
  )

Option handling
Basic colors

f:lilac-main
f:lilac
f:readProjectConf
f:parseProjectConf
f:parseRawProjectConf
f:lilacCompile
f:lilacArchive
f:lilacTangle
f:tangle
f:lilacWeave
f:weaveToDisk
f:lilacJs
f:lilacServe
f:lilacInit
f:mkIndexOrg
f:bootstrapLilac
f:lilacLint
f:gitLsFiles
f:diffSorted
f:putStrColor
f:putStrLnColor

2 main entrypoint

In Haskell, like C, execution starts with the main function.

f:lilac-main
main :: IO ()
main = do
  opts <- customExecParser (prefs showHelpOnEmpty) mainOptions
  lilac opts
  where
    mainOptions =
      info
        (helper <*> versionOptionHandler <*> globalOptionsHandler)
        lilacDesc
    lilacDesc :: InfoMod a
    lilacDesc =
      fullDesc
        <> header
          """
          lilac - Literate programming with Orgmode and Noweb-style blocks.
          """
    versionOptionHandler :: OptionHandler (a -> a)
    versionOptionHandler =
      let cabalVersion = version
       in infoOption
            (concat [showVersion cabalVersion, "-", $(lilacVersion)])
            (long "version" <> short 'v' <> help "Show version.")

Once the CLI arguments and options are handled, we call f:lilac, which branches out into various subcommands.

f:lilac
lilac :: GlobalOpts -> IO ()
lilac globalOpts = case globalOpts.subcommand of
  ComArchive archiveOpts -> lilacArchive globalOpts archiveOpts
  ComCompile compileOpts -> lilacCompile globalOpts compileOpts
  ComTangle tangleOpts -> lilacTangle globalOpts tangleOpts
  ComWeave weaveOpts -> lilacWeave globalOpts weaveOpts
  ComLint lintOpts -> lilacLint globalOpts lintOpts
  ComServe serveOpts -> lilacServe globalOpts serveOpts
  ComInit initOpts -> lilacInit globalOpts initOpts

Before we can tangle or weave, we have to first compile Org files into object files, and then create archives out of these object files.

2.1 General option handling boilerplate

The option handling code is made up of some declarative configuration of the options, and the functions that operate on them.

One useful helper we have to write ourselves is a parser that can understand how to parse OsPath from command line arguments. This is needed because Options.Applicative does not know how to parse OsPath values (only FilePath).

f:readOsPath
readOsPath :: ReadM OsPath
readOsPath = f =<< str
  where
    f :: (MonadFail m) => FilePath -> m OsPath
    f maybeOsPath
      | Just osPath <- P.encodeUtf maybeOsPath,
        P.isValid osPath =
          pure osPath
      | otherwise = fail $ "invalid OsPath: " <> maybeOsPath

Another helper is a parser for newtype:GPath, whose type we need for data:Archive.

f:readGPath
readGPath :: ReadM GPath
readGPath = encodeGPath =<< str

Notice that the option handling boilerplate does not describe error handling (what to do when a required option is missing, etc), because all of that is given to us for free by Options.Applicative.

2.2 Project configuration

The starting point of the CLI is the concept of project configuration. Project configuration defines some global settings that apply to some Lilac subcommands. For example, when weaving these settings apply to the weavable artifacts found in a data:Archive, which itself is composed of a collection of data:Object values. Project configuration is encoded in data:ProjectConf.

data:ProjectConf
type ProjectConf :: Type
data ProjectConf = ProjectConf
  { name :: Text, -- 1
    homepage :: Maybe N.URI, -- 2
    repo :: Maybe N.URI, -- 3
    version :: Maybe Text, -- 4
    nonTangledPathspecs :: [Text], -- 5
    bibliography :: [FilePath], -- 6
    citationStyle :: Maybe FilePath, -- 7
    htmlHead :: Maybe HtmlHead -- 8
  }
  deriving stock (Eq, Generic, Show)

The fields are:

Project configuration isn't part of data:Archive because it may be the case in the future that a single project could be used for multiple archive files.

2.2.1 HTML <head> customization

Lilac is hosted on SourceHut; SourceHut's content security policy (CSP) blocks CSS and JS imports from domains other than the current one. This means we cannot use the default CDNs for pulling in things like MathJax or Google Fonts. Instead we have to vendor these assets and then serve them locally.

data:HtmlHead allows the user to customize the HTML <head> to address the concerns stated above.

data:HtmlHead
type HtmlHead :: Type
data HtmlHead = HtmlHead
  { onlyLocalImports :: Bool, -- 9
    injection :: Maybe Text -- 10
  }
  deriving stock (Eq, Generic, Show)
  deriving (FromValue, ToValue, ToTable) via GenericTomlTable HtmlHead

onlyLocalImports 9, if true, will disable the weaving of MathJax and Google fonts imports. The user can then specify their (vendored) replacements in the injection 10 field.

2.2.2 Simple project configuration

The data:ProjectConf would be very difficult to use if we expect users to write the TOML version of it manually, because it is a precise type (e.g., writing the value of a URI can be painful). So instead we let users write a simplified version of it in TOML (as data:RawProjectConf), using plain Text values for the fields. During weaving we parse this and convert it to data:ProjectConf.

data:RawProjectConf
type RawProjectConf :: Type
data RawProjectConf = RawProjectConf
  { name :: Text,
    homepage :: Text,
    repo :: Text,
    version :: Text,
    nonTangledPathspecs :: [Text],
    bibliography :: Maybe [Text],
    citationStyle :: Maybe Text, -- 11
    htmlHead :: Maybe HtmlHead
  }
  deriving stock (Eq, Generic, Show)
  deriving (FromValue, ToValue, ToTable) via GenericTomlTable RawProjectConf

All keys are expected, except those that use Maybe. So citationStyle 11 is optional.

f:parseRawProjectConf
parseRawProjectConf :: Text -> Either String RawProjectConf
parseRawProjectConf input =
  case Toml.decode input of
    Failure errs -> Left ("TOML Error:\n" <> intercalate "\n" errs)
    Success _ c -> Right c

f:parseProjectConf relies on f:parseRawProjectConf for the initial parse, and some additional helpers like N.parseURI.

f:parseProjectConf
parseProjectConf :: Text -> Either String ProjectConf
parseProjectConf input = case parseRawProjectConf input of
  Left errMsg -> Left errMsg
  Right rawProjectConf ->
    Right
      ProjectConf
        { name = rawProjectConf.name,
          homepage = N.parseURI $ T.unpack rawProjectConf.homepage,
          repo = N.parseURI $ T.unpack rawProjectConf.repo,
          version =
            if T.null rawProjectConf.version
              then Nothing
              else Just rawProjectConf.version,
          nonTangledPathspecs = rawProjectConf.nonTangledPathspecs,
          bibliography = fmap T.unpack $ fromMaybe [] rawProjectConf.bibliography,
          citationStyle = fmap T.unpack $ rawProjectConf.citationStyle,
          htmlHead = rawProjectConf.htmlHead
        }

2.2.3 Blank ProjectConf

f:emptyProjectConf is an empty project configuration, useful mostly for test cases that need a blank one.

f:emptyProjectConf
emptyProjectConf :: ProjectConf
emptyProjectConf =
  ProjectConf
    { name = "Test Project",
      homepage = Nothing,
      repo = Nothing,
      version = Nothing,
      nonTangledPathspecs = [],
      bibliography = [],
      citationStyle = Nothing,
      htmlHead = Nothing
    }

2.3 Global and subcommand options

The data:GlobalOpts are options that can affect more than one subcommand (thought not all subcommands currently use them).

data:GlobalOpts
type GlobalOpts :: Type
data GlobalOpts = GlobalOpts
  { subcommand :: Subcommand,
    projectConf :: OsPath,
    color :: Bool,
    verbose :: Bool
  }

The most important field here is probably subcommand, which informs our binary which subcommand the user chose --- compile, archive, tangle, or weave.

data:Subcommand
type Subcommand :: Type
data Subcommand
  = ComCompile CompileOpts
  | ComArchive ArchiveOpts
  | ComTangle TangleOpts
  | ComWeave WeaveOpts
  | ComLint LintOpts
  | ComServe ServeOpts
  | ComInit InitOpts

Each of these <...>Opts data types require their own option handler, so that Options.Applicative can generate all of the option handling behaviors for us. This involves setting default option values, help text, what types of arguments are expected for some options, etc. All of these concerns are handled within the Options.Applicative.Parser type. However, we use the type data:OptionHandler for option parsing on the CLI, because the alternative of calling it as just Parser feels a bit confusing, given how we already use type:OrgParser (and the concept of a "parser" in general) to mean the Org parsing mechanism we have in module:Lilac.Parse).

data:OptionHandler
type OptionHandler :: Type -> Type
type OptionHandler = Options.Applicative.Parser

Let's first look at the f:globalOptionsHandler, the handler for all global options (apart from the help and version flags which we add into mainOptions in f:lilac-main).

f:globalOptionsHandler
globalOptionsHandler :: OptionHandler GlobalOpts
globalOptionsHandler =
  GlobalOpts
    <$> subcommandHandler
    <*> ( option
            readOsPath
            ( long "project-conf"
                <> metavar "PROJECT_CONF"
                <> value (P.unsafeEncodeUtf "Lilac.toml")
                <> showDefault
                <> help
                  """
                  Project configuration file, in TOML.
                  """
            )
        )
    <*> ( flag
            True
            False
            ( long "no-color"
                <> help
                  """
                  Do not print in color (i.e., suppress ANSI escape codes).
                  """
            )
        )
    <*> ( flag
            False
            True
            ( long "verbose"
                <> help
                  """
                  Be more descriptive about what's happening.
                  """
            )
        )

The global options in f:globalOptionsHandler can be provided anywhere on the command line (unlike subcommand options which must come after the subcommand).

In case you're not familiar with applicative syntax, the basic idea is that you use <$> (map) followed by as many <*> (apply) bits. In f:globalOptionsHandler we use 3 of these in total (1 <$> and 2 <*>) because data:GlobalOpts has 3 fields. This is the beauty of Options.Applicative --- things just line up in a declarative way.

Now let's look at f:subcommandHandler.

f:subcommandHandler
subcommandHandler :: OptionHandler Subcommand
subcommandHandler =
  hsubparser -- 12
    $ metavar "SUBCOMMAND"
    <> cmdCompile
    <> cmdArchive
    <> cmdTangle
    <> cmdWeave
    <> cmdServe
    <> cmdLint
    <> cmdInit
  where
    cmdCompile =
      command
        "compile"
        $ info
          (ComCompile <$> compileOptsHandler)
          (progDesc "Compile Org files into objects.")
    cmdArchive =
      command
        "archive"
        $ info
          (ComArchive <$> archiveOptsHandler)
          (progDesc "Combine objects into a single archive.")
    cmdTangle =
      command
        "tangle"
        $ info
          (ComTangle <$> tangleOptsHandler)
          (progDesc "Extract source code from archives.")
    cmdWeave =
      command
        "weave"
        $ info
          (ComWeave <$> weaveOptsHandler)
          (progDesc "Generate HTML documentation from archives.")
    cmdServe =
      command
        "serve"
        $ info
          (ComServe <$> serveOptsHandler)
          (progDesc "Serve a directory of HTML files.")
    cmdLint =
      command
        "lint"
        $ info
          (ComLint <$> lintOptsHandler)
          (progDesc "Look for tracked files that are not tangled by Lilac.")
    cmdInit =
      command
        "init"
        $ info
          (ComInit <$> initOptsHandler)
          (progDesc "Initialize a new (empty) Lilac project.")

This just delegates to hsubparser 12, which combines a group of individual subcommands into a single parser. Notice that each of the subcommands in turn delegate to a <...>OptsHandler function.

3 Compiling

The f:lilacCompile function creates "object" files for all given Org files. Object files encode information about the Org file in a nice, machine-readable way. They are essentially the machine-readable equivalent of human-readable Org files.

The created files have the .lobj extension to indicate "Lilac object". The compile subcommand writes an object (*.lobj) file for the given Org file. This object file is used to perform some amount of processing (compilation) for the Org file, such that subsequent steps like tangling or weaving can trust that the input is well-formed. This is similar to how the C programming language toolchain uses object files (by compiling C files).

data:CompileOpts
type CompileOpts :: Type
data CompileOpts = CompileOpts
  { inputs :: [OsPath]
  }

The inputs option just takes a list of paths to Org files.

f:compileOptsHandler
compileOptsHandler :: OptionHandler CompileOpts
compileOptsHandler =
  CompileOpts
    <$> (some $ argument readOsPath (metavar "ORG_FILES..."))

In f:lilacCompile, for each Org file, we run f:orgDocParser 13 and then call f:mkObject 14 to turn it into an object, before writing it back onto disk (next to where we found the Org file).

f:lilacCompile
lilacCompile :: GlobalOpts -> CompileOpts -> IO ()
lilacCompile _globalOpts compileOpts = do
  objsAndPaths <- mapM genObject compileOpts.inputs
  mapM_ writeObjToPath objsAndPaths
  where
    genObject inputPath = do
      input <- LU.readFileRobustly inputPath
      let parseResult =
            MP.runParser
              (runStateT LP.orgDocParser defaultOrgParserState) -- 13
              (show inputPath)
              input
      case parseResult of
        Left errBundle -> do
          die $ MP.errorBundlePretty errBundle
        Right (orgDoc, _) -> do
          let obj = LC.mkObject orgDoc -- 14
          pure (obj, inputPath)
    writeObjToPath :: (ToJSON a) => (a, OsPath) -> IO ()
    writeObjToPath (obj, inputPath) = do
      outPath <- do
        let base = P.replaceExtension inputPath $ P.unsafeEncodeUtf "lobj"
        P.decodeUtf base
      encodeFile outPath obj

4 Archiving

The archive subcommand writes an archive (*.larc) file for the given set of Lilac object files (generated with the compile subcommand). See data:Archive for details; essentially this is just a collection of multiple data:Object files to allow for multi-Org-file tangling (where code blocks from one Org file can reference blocks from other files).

data:ArchiveOpts
type ArchiveOpts :: Type
data ArchiveOpts = ArchiveOpts
  { inputs :: [GPath],
    outFile :: OsPath
  }
f:archiveOptsHandler
archiveOptsHandler :: OptionHandler ArchiveOpts
archiveOptsHandler =
  ArchiveOpts
    <$> ( some
            $ argument
              readGPath
              ( metavar "OBJECTS..."
                  <> help
                    """
                    Objects to combine into an archive.
                    """
              )
        )
    <*> ( option
            readOsPath
            ( long "out-file"
                <> metavar "FILE"
                <> value (P.unsafeEncodeUtf "out.larc")
                <> showDefault
                <> help
                  """
                  Output file path for the archive.
                  """
            )
        )

The act of archiving is pretty simple. It just reads in all of the object files and then calls f:mkArchive on them to create and archive, before writing it out to disk based on the --out-file option.

f:lilacArchive
lilacArchive :: GlobalOpts -> ArchiveOpts -> IO ()
lilacArchive globalOpts archiveOpts = do
  projectConf <- readProjectConf globalOpts.projectConf
  pathsObjects <- mapM readObjectDirectly archiveOpts.inputs
  maybeArchive <- LC.mkArchive projectConf pathsObjects
  case maybeArchive of
    Left errMsg -> die errMsg
    Right archive -> do
      let cycles = LC.findCycles archive
      when (not $ null cycles) $ do
        die
          $ "Found cycles: "
          <> intercalate
            "\n"
            (map show cycles)
      outPath <- do
        let base =
              P.replaceExtension archiveOpts.outFile
                $ P.unsafeEncodeUtf "larc"
        P.decodeUtf base
      encodeFile outPath archive
  where
    readObjectDirectly :: GPath -> IO (GPath, Object)
    readObjectDirectly gPath = do
      let fp = decodeGPath gPath
          inputPath = P.unsafeEncodeUtf fp
      text <- LU.readFileRobustly inputPath
      case eitherDecodeStrictText text :: Either String Object of
        Left errMsg -> die errMsg
        Right obj -> pure (gPath, obj)

5 Tangling

The tangle subcommand runs f:lilacTangle. It can tangle all code blocks (which have been marked for tangling) found in all archives specified with the inputs field.

data:TangleOpts
type TangleOpts :: Type
data TangleOpts = TangleOpts
  { inputs :: [GPath],
    outDir :: OsPath
  }

The outDir field can "direct" the tangling to be done at any other arbitrary location. See the help text in f:tangleOptsHandler for details.

f:tangleOptsHandler
tangleOptsHandler :: OptionHandler TangleOpts
tangleOptsHandler =
  TangleOpts
    <$> (some $ argument readGPath (metavar "ARCHIVES..."))
    <*> ( option
            readOsPath
            ( long "out-dir"
                <> metavar "DIR"
                <> value mempty
                <> showDefault
                <> help
                  """
                  Directory used for tangling. It's the starting point from
                  which all of the code blocks' ":tangle" header will be a
                  child of. Typically you'd want this to point to your repo's
                  root directory, so you can tangle a file in any location in
                  the repo root, regardless of where your Org files are authored
                  and checked into version control.
                  """
            )
        )

The f:lilacTangle function calls f:tangle for each of the archive files in the given list of inputs.

f:lilacTangle
lilacTangle :: GlobalOpts -> TangleOpts -> IO ()
lilacTangle globalOpts tangleOpts = do
  mapM_ tangleArchiveFile tangleOpts.inputs
  where
    tangleArchiveFile gPath = do
      let fp = decodeGPath gPath
          inputPath = P.unsafeEncodeUtf fp
      text <- LU.readFileRobustly inputPath
      case eitherDecodeStrictText text :: Either String Archive of
        Left errMsg -> die errMsg
        Right archive -> do
          when (globalOpts.verbose) $ do
            putStrLn' $ "Tangling " <> fp
          tangle globalOpts tangleOpts archive
          when (globalOpts.verbose)
            $ putStrLn' "Finished tangling."
    putStrLn' =
      if globalOpts.color
        then putStrLnColor boldWhite
        else putStrLn

In f:tangle we naively tangle each file, one at a time, in serial fashion. It does not write to the file if what would be written is the same as what's already there. This way, file modification timestamps can remain the same and tools like GNU Make won't get confused by timestamps that have been needlessly updated. However, we always do write the file if it doesn't exist on disk.

f:tangle
tangle :: GlobalOpts -> TangleOpts -> Archive -> IO ()
tangle globalOpts tangleOpts archive = do
  let blocks = sort $ LT.expandRootBlocks archive tangleOpts.outDir
  putStrLn' $ "Blocks to process: " <> (show $ length blocks)
  (tangled, tangledPaths, skipped) <- foldlM f (0, [], 0) blocks
  putStrLn' $ "Tangled: " <> (show tangled)
  when (tangled > 0) $ mapM_ printTangled $ reverse tangledPaths
  putStrLn' $ "Skipped: " <> (show skipped)
  where
    f :: (Int, [OsPath], Int) -> (OsPath, Text) -> IO (Int, [OsPath], Int)
    f (tangled, tangledPaths, skipped) (path, contentToWrite) = do
      alreadyExists <- D.doesPathExist path
      existingContent <- LU.readFileRobustly path
      let g
            | (alreadyExists && existingContent /= contentToWrite)
                || not alreadyExists = do
                LU.writeFileRobustly path contentToWrite
                pure (tangled + 1, path : tangledPaths, skipped)
            | otherwise = pure (tangled, tangledPaths, skipped + 1)
       in g
    printTangled :: OsPath -> IO ()
    printTangled path = do
      fp <- P.decodeUtf path
      putStrLn $ "  " <> fp
    putStrLn' =
      if globalOpts.color
        then putStrLnColor boldWhite
        else putStrLn

Most of the heavy lifting around determining what to tangle is done by f:expandRootBlocks. We sort the paths so that the output is less confusing. Only tangled paths are printed, because otherwise the output can be overly verbose.

The function f:readFileRobustly will return the empty string if there was any error encountered while reading the file. One common scenario is if the file does not exist yet. Returning the empty string in this (or other error-raising scenarios) is fine because it will most likely result in the comparison existingContent /= contentToWrite in f:tangle failing (assuming the contentToWrite is not empty), resulting in the file being marked for tangling.

5.1 Linting tangled paths

In Literate Programming (LP), it's an anti-pattern to write code directly without explaining it in detail. In other words, most of the files in a repository using LP should be able to be traced back to code block in a larger literate document. We can check for this by comparing all tangled paths against what's tracked in version control by Git (listed by git-ls-files). The two should be mostly equivalent.

We say "mostly equivalent" because some files will be generated by tools other than Lilac (e.g., .gitmodules if you are using Git submodules). We need to exclude these files from the output of git-ls-files (see toml:RawProjectConfig1 to see how these excluded pathspecs are defined).

data:LintOpts
type LintOpts :: Type
data LintOpts = LintOpts
  { inputs :: [OsPath] -- 15
  }

The inputs 15 are paths to archive files.

f:lintOptsHandler
lintOptsHandler :: OptionHandler LintOpts
lintOptsHandler =
  LintOpts
    <$> (some $ argument readOsPath (metavar "ARCHIVES..."))

f:lilacLint just reads all tangled paths in code blocks across all cells in all objects in all archives, as tangledFiles 16. It compares this to the list of tracked files, which are obtained by asking Git via f:gitLsFiles. The final diff is displayed with f:diffSorted.

f:lilacLint
lilacLint :: GlobalOpts -> LintOpts -> IO ()
lilacLint globalOpts lintOpts = do
  projectConf <- readProjectConf globalOpts.projectConf
  rawOutput <- gitLsFiles projectConf.nonTangledPathspecs
  let trackedFiles =
        sort
          . map (TE.decodeUtf8Lenient . LBS.toStrict)
          $ LBS.lines rawOutput
  lintArchives lintOpts.inputs trackedFiles
  where
    lintArchives :: [OsPath] -> [Text] -> IO ()
    lintArchives inputPaths trackedFiles = do
      -- 16
      tangledFiles <-
        sort . concat <$> mapM getTangledPathsFromArchive inputPaths
      let diff = diffSorted tangledFiles trackedFiles
      when (not $ null diff) $ do
        putStrLn "Tangled files and tracked files do not match."
        putStrLn "---------------------------------------------"
        forM_ diff $ \(b, path) -> do
          let prefix =
                if b
                  then "tracked but not tangled: "
                  else "tangled but not tracked: "
          putTextLn $ prefix <> path
        exitFailure
    getTangledPathsFromArchive :: OsPath -> IO [Text]
    getTangledPathsFromArchive inputPath = do
      text <- LU.readFileRobustly inputPath
      case eitherDecodeStrictText text :: Either String Archive of
        Left errMsg -> die errMsg
        Right archive -> do
          let getTangledPaths :: Object -> [Text]
              getTangledPaths obj = mapMaybe getTangledPath obj.orgDoc.cells
          pure $ concatMap getTangledPaths archive.objects
    getTangledPath :: Cell -> Maybe Text
    getTangledPath = \case
      CBlock b -> lookup "tangle" b.meta
      _ -> Nothing

f:readProjectConf reads the project configuration, which houses (among other things) the list of non-tangled pathspecs toml:RawProjectConfig1

f:readProjectConf
readProjectConf :: OsPath -> IO ProjectConf
readProjectConf path = do
  input <- LU.readFileRobustly path
  case parseProjectConf input of
    Left errMsg -> do
      putTextLn "Could not read Lilac.toml"
      die errMsg
    Right projectConf -> pure projectConf

f:gitLsFiles passes the pathspec arguments from toml:RawProjectConfig1.

f:gitLsFiles
gitLsFiles :: [Text] -> IO LByteString
gitLsFiles pathspecs = do
  let args = ["ls-files", "--", "."] <> (map T.unpack pathspecs)
      config = proc "git" args
  readProcessStdout_ config

f:diffSorted Takes two sorted lists and returns a list of differences. False means tangled, but not tracked. True means tracked, but not tangled.

f:diffSorted
diffSorted :: [Text] -> [Text] -> [(Bool, Text)]
diffSorted [] [] = []
diffSorted xs [] = map (False,) xs
diffSorted [] ys = map (True,) ys
diffSorted (x : xs) (y : ys)
  | x == y = diffSorted xs ys
  | x < y = (False, x) : diffSorted xs (y : ys)
  | otherwise = (True, y) : diffSorted (x : xs) ys

6 Weaving

The weave subcommand is similar to tangle in that it takes a list of archives to process. There are a few more options here though, because weaving is a more complex process than tangling.

data:WeaveOpts
type WeaveOpts :: Type
data WeaveOpts = WeaveOpts
  { inputs :: [OsPath],
    outDir :: OsPath,
    rootRelativePrefix :: OsPath,
    writeCss :: Bool,
    writeJs :: Bool
  }

The projectConf is a path to the data:ProjectConf. The writeJs field is only meant to be used when not developing Lilac (when you're using Lilac in production), because this option makes Lilac just write the hardcoded JavaScript it has embedded inside itself (see JavaScript injection and Weave Lilac with Lilac).

f:weaveOptsHandler
weaveOptsHandler :: OptionHandler WeaveOpts
weaveOptsHandler =
  WeaveOpts
    <$> (some $ argument readOsPath (metavar "ARCHIVES..."))
    <*> ( option
            readOsPath
            ( long "out-dir"
                <> metavar "DIR"
                <> value (P.unsafeEncodeUtf ".")
                <> showDefault
                <> help -- 17
                  """
                  Directory for saving the HTML files. CSS and JS are also saved
                  inside this directory, if you use --write-css and --write-js.
                  """
            )
        )
    <*> ( option
            readOsPath
            ( long "root-relative-prefix"
                <> metavar "DIR"
                <> value (P.unsafeEncodeUtf "/")
                <> showDefault
                <> help -- 18
                  """
                  Prefix to use for pulling static assets (CSS and JS). For
                  example, CSS is pulled from
                  "/<ROOT_RELATIVE_PREFIX>/css/default.css". This is useful if
                  for example you want to host your contents in a subdirectory
                  of your server root (instead of the root).
                  """
            )
        )
    <*> ( flag
            False
            True
            ( long "write-css"
                <> help
                  """
                  Write CSS file. This does not require Org mode input.
                  """
            )
        )
    <*> ( flag
            False
            True
            ( long "write-js"
                <> help
                  """
                  Write JS file. This does not require Org mode input.
                  """
            )
        )

The f:lilacWeave function weaves all objects (Org files) it finds inside an archive to HTML.

f:lilacWeave
lilacWeave :: GlobalOpts -> WeaveOpts -> IO ()
lilacWeave globalOpts weaveOpts = do
  projectConf <- readProjectConf globalOpts.projectConf
  when weaveOpts.writeCss writeCssFile
  when weaveOpts.writeJs writeJsFile
  mapM_ (weaveArchiveFile projectConf weaveOpts.outDir) $ weaveOpts.inputs
  where
    writeCssFile = do
      cssPath <- do
        cssDir <- P.encodeUtf "css"
        css <- P.encodeUtf "default.css" -- 19
        pure $ P.joinPath [weaveOpts.outDir, cssDir, css]
      LU.writeFileRobustly cssPath $ LWC.genCss
    writeJsFile = do
      jsPath <- do
        jsDir <- P.encodeUtf "js"
        js <- P.encodeUtf "lilac.js"
        pure $ P.joinPath [weaveOpts.outDir, jsDir, js]
      LU.writeFileRobustly jsPath lilacJs
    weaveArchiveFile projectConf outDir inputPath = do
      text <- LU.readFileRobustly inputPath
      case eitherDecodeStrictText text :: Either String Archive of
        Left errMsg -> die errMsg
        Right archive -> do
          fp <- P.decodeUtf inputPath
          outDir' <- encodeGPath =<< P.decodeUtf outDir
          rootRelativePrefix <-
            encodeGPath =<< P.decodeUtf weaveOpts.rootRelativePrefix
          putStrLn $ "Weaving " <> fp
          sequence_
            $ M.foldlWithKey'
              ( weaveToDisk
                  projectConf
                  outDir'
                  rootRelativePrefix
                  archive
              )
              []
              archive.objects
          putStrLn "Finished weaving."

Weaving to disk is used when we want to choose where to write the HTML. It's just a thin wrapper around f:weaveObject which does most of the work.

f:weaveToDisk
weaveToDisk ::
  ProjectConf ->
  GPath ->
  GPath ->
  Archive ->
  [IO ()] ->
  GPath ->
  Object ->
  [IO ()]
weaveToDisk projectConf outDir rootRelativePrefix archive acc objPath obj =
  let fp = decodeGPath objPath
      ext = P.unsafeEncodeUtf "html"
      outPath = P.replaceExtension (P.unsafeEncodeUtf fp) ext
      action = do
        outDirOsPath <- P.encodeUtf $ decodeGPath outDir
        result <- LW.prepareCitations projectConf objPath obj archive
        let weaveConf =
              WeaveConf
                { projectConf = projectConf,
                  archive = archive,
                  originObjectPath = objPath,
                  outDir = outDir,
                  rootRelativePrefix = rootRelativePrefix,
                  citeprocResult = result
                }
            outPathFinal = P.combine outDirOsPath outPath
        LU.writeFileRobustly outPathFinal
          . LW.renderAsText weaveConf
          $ LW.weaveObject obj
   in action : acc

Unlike tangling where we chose which output directory to use for the tangled outputs, here for weaving we always use the same path where the object files are located, and then change the extension to be .html.

6.1 JavaScript injection

We use ClojureScript to generate the JavaScript we need at make:Build prod JS. That generates a single self-contained JavaScript file. We would like to put this into our CLI (just as we do for CSS generation at CSS generator), because then the CLI really becomes the complete HTML, CSS and JavaScript generation solution, using only Org files as dependencies.

See Weave Lilac with Lilac which discusses how the lilac.js.injectme JavaScript file is generated.

We use the file-embed library to inject the JavaScript file into our CLI. The embedFile function returns a ByteString, so we convert it into Text with TE.decodeUtf8.

f:lilacJs
lilacJs :: Text
lilacJs = TE.decodeUtf8 $(embedFile "js/lilac.js.injectme")

7 Serving

The serve subcommand is useful for serving a directory of HTML files, while also watching for any changes to those HTML files (and reloading the file as needed). See f:lilacServe to see the entrypoint, and Serve for more details.

data:ServeOpts
type ServeOpts :: Type
data ServeOpts = ServeOpts
  { dir :: OsPath,
    port :: Int
  }

f:serveOptsHandler performs some additional validation on the provided options.

f:serveOptsHandler
serveOptsHandler :: OptionHandler ServeOpts
serveOptsHandler =
  ServeOpts
    <$> (argument readOsPath (metavar "DIR"))
    <*> ( option
            portReader
            ( long "port"
                <> metavar "PORT"
                <> value 8080
                <> showDefault
                <> help
                  """
                  Port to serve over.
                  """
            )
        )
  where
    portReader :: ReadM Int
    portReader = eitherReader $ \s ->
      case readMaybe s of
        Just n | n > 0 && n < 65536 -> Right n
        Just _ -> Left "Port must be between 1 and 65535"
        Nothing -> Left "Must be a valid integer"

f:lilacServe creates a new thread to watch for filesystem changes 20, before starting the Warp HTTP server 21. There's some extra work done to shut down the fsWatcher thread 20 gracefully at the end, as part of teardown 22.

f:lilacServe
lilacServe :: GlobalOpts -> ServeOpts -> IO ()
lilacServe globalOpts serveOpts = do
  targetDir <- P.decodeUtf =<< D.makeAbsolute serveOpts.dir
  fsChan <- newBroadcastTChanIO
  activePaths <- newTVarIO mempty
  shutdownSignal <- newEmptyMVar
  fsWatcherDone <- newEmptyMVar
  logLock <- newMVar ()

  _ <-
    forkIO
      $ fsWatcher -- 20
        targetDir
        fsChan
        activePaths
        shutdownSignal
        fsWatcherDone
        logLock
        globalOpts.verbose

  putTextLn $ "Serving Lilac at http://localhost:" <> show serveOpts.port
  putTextLn "Press Ctrl-C to shut down."

  let settings = setPort serveOpts.port defaultSettings
      server =
        liveReloadMiddleware
          targetDir
          fsChan
          logLock
          globalOpts.verbose
          $ staticApp (defaultFileServerSettings targetDir)
      teardown = do
        putTextLn "\nLilac server has stopped."
        putMVar shutdownSignal ()
        takeMVar fsWatcherDone
        putTextLn "Bye!"

  runSettings settings server -- 21
    `finally` teardown -- 22

8 Initialization

The init command can be used to create a basic starter set of files for using Lilac.

data:InitOpts
type InitOpts :: Type
data InitOpts = InitOpts
  { onlyLocalImports :: Bool -- 23
  }

23 determines whether Lilac will generate a purely local (self-contained) set of woven artifacts. More specifically, this means that all of the JS and CSS (including MathJax and fonts) will be downloaded to be hosted locally (instead of reaching out to a CDN to get these assets).

f:initOptsHandler
initOptsHandler :: OptionHandler InitOpts
initOptsHandler =
  InitOpts
    <$> ( flag
            False
            True
            ( long "only-local-imports"
                <> help
                  """
                  Download a local copy of MathJax and fonts so that they can be
                  served locally. This way the woven HTML will refer to the
                  local copy, instead of pulling these artifacts over the
                  network via a CDN.
                  """
            )
        )

Initialization essentially involves writing some files to disk. Below are the files we need to write:

  1. index.org: Needed as the first (root) Lilac file. You can think of this as the README of a project.

  2. Lilac.toml: Needed for using Lilac.

  3. Makefile: Useful for writing down the exact Lilac incantations to get what you want.

  4. .gitignore: Useful for ignoring certain files used by the above Makefile as well as generated files from Lilac (*.lobj, *.larc). Depending on your use case, you'd probably also want to ignore HTML (woven artifacts) generated by Lilac.

  5. .gitattributes: Useful for suppressing the diff of woven artifacts (if you decide to track these artifacts in version control1).

  6. .git-orderfile: Useful to tell Git to show the Org files first when looking at a commit's diff. You'd almost always want this because the Org files are the source of truth.

  7. vendor-mathjax.sh: (Optional) Used to vendor (download) MathJax locally.

  8. vendor-source-fonts.sh: (Optional) Used to vendor (download) Source Sans, Source Serif, and Source Code Pro fonts locally.

Only the first two files need to be written by us. The others can be written by Lilac itself (by making Lilac call itself, with f:bootstrapLilac). If the first two files already exist though, we emit a warning and abort.

f:lilacInit
lilacInit :: GlobalOpts -> InitOpts -> IO ()
lilacInit globalOpts initOpts = do
  let write p = LU.writeOrWarn (P.unsafeEncodeUtf p) -- 24
  uuid <- nextRandom -- 25
  when (globalOpts.verbose) $ do
    putStrLn $ "Using UUID " <> show uuid <> " for index.org"
  let indexOrg = mkIndexOrg initOpts uuid -- 26
  when (globalOpts.verbose) $ do
    putStrLn "Writing index.org"
  write
    "index.org"
    indexOrg
  when (globalOpts.verbose) $ do
    putStrLn "Writing Lilac.toml"
  let lilacToml =
        """
        text:Lilac.toml
        """
          <> if initOpts.onlyLocalImports
            then
              """
              \n
              text:Lilac.toml-htmlHead
              \n
              """
            else ""
  write
    "Lilac.toml"
    lilacToml
  when (globalOpts.verbose) $ do
    putStrLn "Tangling files out of index.org"
  bootstrapLilac initOpts -- 27

f:writeOrWarn 24 uses f:writeFileRobustly to either write the file content or skip if the file path already exists.

f:writeOrWarn
writeOrWarn :: OsPath -> Text -> IO ()
writeOrWarn path contentToWrite = do
  fileExists <- D.doesFileExist path
  if fileExists
    then T.hPutStrLn stderr $ "path " <> T.show path <> " already exists, skipping"
    else writeFileRobustly path contentToWrite

f:mkIndexOrg 26 constructs the all-important index.org file.

f:mkIndexOrg
mkIndexOrg :: InitOpts -> UUID -> Text
mkIndexOrg initOpts uuid =
  ":PROPERTIES:\n:ID:       "
    <> show uuid
    <> "\n:END:\n"
    <> """
       text:index.org
       """ -- 28
    <> maybeHtmlHead
    <> """
       text:index.org-after-Lilac.toml
       """
    <> maybeVendorScripts
  where
    maybeHtmlHead =
      if initOpts.onlyLocalImports
        then
          "\n"
            <> """
               text:Lilac.toml-htmlHead
               """
            <> "\n"
        else ""
    maybeVendorScripts =
      if initOpts.onlyLocalImports
        then
          "\n"
            <> """
               text:vendor-mathjax
               """
            <> "\n\n"
            <> """
               text:vendor-source-fonts
               """
            <> "\n"
        else ""

f:bootstrapLilac 27 calls Lilac to tangle some files out of the index.org file (which is from text:index.org).

f:bootstrapLilac
bootstrapLilac :: InitOpts -> IO ()
bootstrapLilac initOpts = do
  let runLilac :: [String] -> IO ()
      runLilac args = do
        outputLBS <- readProcessStdout_ $ proc "lilac" args
        putLBS outputLBS
  runLilac ["compile", "index.org"]
  runLilac ["archive", "index.lobj", "--out-file", "hello-world.larc"]
  runLilac ["tangle", "hello-world.larc", "--out-dir", "."] -- 29
  when initOpts.onlyLocalImports $ do
    putLBS =<< readProcessStdout_ (proc "bash" ["vendor-mathjax.sh"])
    putLBS =<< readProcessStdout_ (proc "bash" ["vendor-source-fonts.sh"])
  putLBS =<< readProcessStdout_ (proc "make" [])

8.1 Files to write

8.1.1 Lilac.toml

text:Lilac.toml is a basic template; the user is expected to tweak this file first (inside the index.org file).

text:Lilac.toml
name = "Hello World"
homepage = "https://localhost"
repo = "https://localhost"
version = "1.2.3"

nonTangledPathspecs = [
    ":(exclude,top).gitmodules",
    ":(exclude,top)LICENSE",
    ":(exclude,top)*.org",
    ":(exclude,top)*.html",
    ":(exclude,top)site"
]

If the user passes --only-local-imports, then we have to tweak the Lilac.toml so that all woven HTML files know how to fetch the vendored artifacts.

text:Lilac.toml-htmlHead
[htmlHead]
onlyLocalImports = true
injection = \"\"\"
<link rel="stylesheet" href="/vendor/source-fonts/source-fonts.css">
<script>
  window.MathJax = {
      loader: { paths: { "mathjax-newcm": "/vendor/mathjax-newcm-font" } },
      output: { font: "mathjax-newcm" },
  tex: {
      tags: 'ams'
  },
  options: {
      ignoreHtmlClass: 'verbatim|code'
  }
};
</script>
<script id="MathJax-script" async="" src="/vendor/mathjax/tex-mml-chtml.js"></script>
\"\"\"

8.1.2 index.org

text:index.org has all of the files we need to bootstrap a Lilac project. The only thing missing from it is the unique UUID for the document; this is generated at 25 and prepended to it.

We have to use a \t for the tab character and \\ for the \ character, because that's what Haskell's triple quoting syntax requires 28.

text:index.org
#+title: Introduction

Modify this file to suit your project's needs.

* Lilac configuration

#+header: :tangle Lilac.toml
#+begin_src toml
text:Lilac.toml

text:index.org-after-Lilac.toml exists so that we can optionally append some extra text after text:Lilac.toml (namely text:Lilac.toml-htmlHead). That is, it's just a simple way to break up the long multiline string into multiple parts so that we can inject things in the middle of it. There are other ways to achieve the same effect (e.g., adding a magic string and replacing it), but this way is probably the simplest.

text:index.org-after-Lilac.toml
#+end_src

The ~nonTangledPathspecs~ is used by Lilac's ~lint~
subcommand, which checks for any differences between what is tangled and what is
tracked by Git. These two sets of files should mostly overlap. Any files that
are intentionally *not* tangled by Lilac should be listed in ~nonTangledPathspecs~.
These are fed to ~git-ls-files~ to ignore tracked files that are not tangled by
Lilac.

* Makefile

#+name: Makefile
#+header: :tangle Makefile
#+begin_src makefile
org_files = \\
\tindex.org

obj_files = $(org_files:%.org=%.lobj)

archive_file = hello-world.larc

all: tangle weave lint
.PHONY: all

$(obj_files) &: $(org_files)
\tlilac compile $?
\ttouch $(obj_files)

$(archive_file): $(obj_files)
\tlilac archive $^ --out-file $@

tangle: $(archive_file)
\tlilac tangle $< --out-dir .
\ttouch tangle

weave: $(archive_file)
\tlilac weave $< --out-dir site --write-css --write-js
\trm -rf site/vendor
\tcp -r vendor site
\ttouch weave

lint: $(archive_file)
\tlilac lint $<
\ttouch lint

clean:
\trm -rf \\
\t\t$(archive_file) \\
\t\t$(obj_files)
.PHONY: clean

<<git-orderfile-gitconfig>>
#+end_src

* Git

** ~.gitignore~

Ignore hidden files, but don't ignore some that we explicitly
tangle such as ~.gitattributes~.

#+header: :tangle .gitignore
#+begin_src gitignore
,**/.*

!**.gitattributes
!**.gitignore
!**.git-orderfile
,*.lobj
,*.larc
lint
tangle
weave
site/
#+end_src

The ~*.lobj~ and ~*.larc~ files are generated by Lilac, so ignore them too. The
~lint~, ~tangle~, and ~weave~ files are sentinel files used by the Makefile, so ignore
them too.

** ~.gitttributes~

As the HTML files are generated (woven) by Lilac, ignore them from diffs. The
same goes for all woven content (~site~ folder) generated by Lilac.

#+header: :tangle .gitattributes
#+begin_src txt
,*.html -diff
site/* -diff
#+end_src

** Git orderfile

Make ~git-diff~ show the Org files first, because they serve as the source of
truth.

#+name: git-orderfile
#+header: :tangle .git-orderfile
#+begin_src txt
# Org files
index.org
,*.org
#+end_src

As there is no standard filename for this, you have to tell Git to use it
explicitly.

#+name: git-orderfile-gitconfig
#+begin_src makefile
gitconfig:
\tgit config diff.orderfile .git-orderfile
.PHONY: gitconfig
#+end_src

8.2 Vendored assets

8.2.1 MathJax

text:vendor-mathjax is a little messy because it needs to escape tab characters and also \ with \\, because this text is fed into Haskell's triple-quote multiline string.

text:vendor-mathjax
** MathJax

For MathJax, we download it from NPM. We actually need 2 packages, the main
MathJax code and also the font.

#+name: vendor-mathjax.sh
#+header: :tangle vendor-mathjax.sh
#+header: :shebang #!/usr/bin/env bash
#+begin_src bash
set -euo pipefail

MAIN_PACKAGE="mathjax"
FONT_PACKAGE="mathjax-newcm-font"
VERSION="4.1.2"

mkdir -p vendor
pushd vendor

download_tarball()
{
\tlocal package
\tlocal version
\tlocal url_prefix
\tlocal tarball
\tpackage="${1:-}"
\tversion="${2:-}"
\ttarball="${package}-${version}.tgz"
\turl_prefix="${3:-}"

\tif [[ -d "${package}" ]]; then
\t\techo "${package} directory already exists"
\t\treturn 1
\tfi

\tcurl -OL "${url_prefix}/-/${tarball}"
\ttar xzvf "${tarball}"
\tmv package "${package}"
\trm "${tarball}"
}

download_tarball \\
\t"${MAIN_PACKAGE}" \\
\t"${VERSION}" \\
\t"https://registry.npmjs.org/mathjax"
download_tarball \\
\t"${FONT_PACKAGE}" \\
\t"${VERSION}" \\
\t"https://registry.npmjs.org/@mathjax/${FONT_PACKAGE}"
#+end_src

8.2.2 Source family of fonts

We download variable weight fonts to keep things lightweight.

text:vendor-source-fonts
** Source family of fonts

Lilac uses Google web fonts by default to pull these fonts dynamically at runtime. However, these fonts are all open source so we can just download them from their GitHub repos directly, which is what we do here.

#+name: vendor-source-fonts.sh
#+header: :tangle vendor-source-fonts.sh
#+header: :shebang #!/usr/bin/env bash
#+begin_src bash
set -euo pipefail

url_sans="https://raw.githubusercontent.com/adobe-fonts/source-sans/3.052R"
url_serif="https://raw.githubusercontent.com/adobe-fonts/source-serif/4.005R"
url_code="https://raw.githubusercontent.com/adobe-fonts/source-code-pro/2.042R-u%2F1.062R-i%2F1.026R-vf"

mkdir -p vendor/source-fonts
pushd vendor/source-fonts

curl -OL "${url_sans}/WOFF2/VF/SourceSans3VF-Italic.otf.woff2"
curl -OL "${url_sans}/WOFF2/VF/SourceSans3VF-Upright.otf.woff2"

curl -OL "${url_serif}/WOFF2/VAR/SourceSerif4Variable-Italic.otf.woff2"
curl -OL "${url_serif}/WOFF2/VAR/SourceSerif4Variable-Roman.otf.woff2"

curl -OL "${url_code}/WOFF2/VF/SourceCodeVF-Italic.otf.woff2"
curl -OL "${url_code}/WOFF2/VF/SourceCodeVF-Upright.otf.woff2"

cat <<EOF >source-fonts.css
text:source-fonts.css
EOF
#+end_src

Having text:source-fonts.css as a separate block lets gives us syntax highlighting (because there aren't any special characters that need to be escaped in Haskell's triple-quote multiline syntax).

text:source-fonts.css
@font-face{
    font-family: 'font-mono';
    font-weight: 200 900;
    font-style: normal;
    font-stretch: normal;
    src: url('SourceCodeVF-Upright.otf.woff2') format('woff2');
}

@font-face{
    font-family: 'font-mono';
    font-weight: 200 900;
    font-style: italic;
    font-stretch: normal;
    src: url('SourceCodeVF-Italic.otf.woff2') format('woff2');
}

@font-face{
    font-family: 'font-sans';
    font-weight: 200 900;
    font-style: normal;
    font-stretch: normal;
    src: url('SourceSans3VF-Upright.otf.woff2') format('woff2');
}

@font-face{
    font-family: 'font-sans';
    font-weight: 200 900;
    font-style: italic;
    font-stretch: normal;
    src: url('SourceSans3VF-Italic.otf.woff2') format('woff2');
}

@font-face{
    font-family: 'font-serif';
    font-weight: 200 900;
    font-style: normal;
    font-stretch: normal;
    src: url('SourceSerif4Variable-Roman.otf.woff2') format('woff2');
}

@font-face{
    font-family: 'font-serif';
    font-weight: 200 900;
    font-style: italic;
    font-stretch: normal;
    src: url('SourceSerif4Variable-Italic.otf.woff2') format('woff2');
}

9 Git version injection

We want to inject Git version information (as it was detected during the build) into the lilac binary. There is some complication because we want to do this for both Cabal and Nix.

The traditional way of doing Git version injection is with Template Haskell, by invoking git during compile time. For an overview of working with Template Haskell, see this StackOverflow comment and answer.

However, invoking git doesn't work in all cases, especially when building with Nix because when Nix builds things it doesn't use the Git repository (see nix:lilacSource).

First let's get the imports out of the way.

module:Lilac.Version
🎯 src/Lilac/Version.hs
module Lilac.Version
  ( lilacVersion,
  )
where

import Control.Monad.Trans.Cont
  ( ContT,
    callCC,
    evalContT,
  )
import Data.Time.LocalTime (getZonedTime)
import Language.Haskell.TH (Exp, Q, runIO, stringE)
import Relude
  ( IO,
    MonadTrans,
    String,
    concat,
    filter,
    fromMaybe,
    lift,
    not,
    null,
    pure,
    show,
    when,
    ($),
    (/=),
    (<$>),
    (=<<),
  )
import System.Environment (lookupEnv)
import System.Process (readProcess)

f:lilacVersion
f:getGitVersion
f:tryLilacGitVersion
f:tryLilacProjectRoot
f:versionFallback
f:getEnv

The entrypoint is f:lilacVersion, which combines Git information with the timestamp of when the binary was built. That in turn calls f:getGitVersion where most of the heavy lifting happens.

f:lilacVersion
lilacVersion :: Q Exp
lilacVersion = stringE =<< runIO getCombinedVersion

getCombinedVersion :: IO String
getCombinedVersion = do
  gitVersion <- filter (/= '\n') <$> getGitVersion
  timestamp <- getTimestamp
  pure $ concat [gitVersion, " (", timestamp, ")"]

getTimestamp :: IO String
getTimestamp = show <$> getZonedTime

In f:getGitVersion we use the continuation monad transformer to make the IO computations be able to return early (without executing the rest of the do-block), with escapeWith. The escapeWith function itself isn't anything special (we don't define it), and it is called an "escape continuation" according to the transformers library and this behavior is built into ContT. For our purposes we just know that invoking escapeWith means we'll escape the computation early with the provided argument.

f:getGitVersion
getGitVersion :: IO String
getGitVersion = evalContT $ callCC $ \escapeWith -> do
  tryLilacGitVersion escapeWith
  tryLilacProjectRoot escapeWith
  versionFallback

The first thing we check is for LILAC_GIT_VERSION via f:tryLilacGitVersion, which is used by nix-build. This is because in Nix we cannot use LILAC_PROJECT_ROOT because the nix-build process (and also any child process such as git) won't have permission to enter the LILAC_PROJECT_ROOT.

So instead we have to defer the responsibility of looking up this Git information to the build process itself (see make:Build lilac with Nix). We simply read the value of LILAC_GIT_VERSION and use this string (as long as it's not empty) as is.

f:tryLilacGitVersion
tryLilacGitVersion :: (MonadTrans t) => (String -> t IO ()) -> t IO ()
tryLilacGitVersion escapeWith = do
  gitVersion <- lift $ getEnv "LILAC_GIT_VERSION"
  when (not $ null gitVersion) $ escapeWith gitVersion

getEnv looks up an environment variable, but returns the empty string if the environment variable was not found.

f:getEnv
getEnv :: String -> IO String
getEnv env = fromMaybe "" <$> lookupEnv env

That's it for the first case of building inside a Nix build process.

If we're not inside a Nix build process (such as in a cabal build), we are not bound by any of the sandboxing rules involved. So we can invoke the git binary ourselves. This is what we do in f:tryLilacProjectRoot, but only if the LILAC_PROJECT_ROOT is set. Again, we expect the build environment to have set this value to a valid Git repository path that houses the Lilac code.

f:tryLilacProjectRoot
tryLilacProjectRoot :: (MonadTrans t) => (String -> t IO ()) -> t IO ()
tryLilacProjectRoot escapeWith = do
  projectRoot <- lift $ getEnv "LILAC_PROJECT_ROOT"
  when (not $ null projectRoot) $ do
    gitOutput <-
      lift
        $ readProcess
          "git"
          ["-C", projectRoot, "describe", "--abbrev=10", "--always", "--dirty"]
          ""
    escapeWith gitOutput

Lastly if neither LILAC_GIT_VERSION nor LILAC_PROJECT_ROOT are found, we return unknown-build-env. This will never happen as long as our build environment is working correctly. Still, it's good to have a fallback that can inform the user how this version information came to be.

f:versionFallback
versionFallback :: ContT String IO String
versionFallback = pure "unknown-build-env"

10 Colored terminal output

These two functions help us print text to standard output using colors.

f:putStrColor
putStrColor :: [C.SGR] -> String -> IO ()
putStrColor sgrs s = do
  C.setSGR sgrs
  putStr s
  C.setSGR [C.Reset]
f:putStrLnColor
putStrLnColor :: [C.SGR] -> String -> IO ()
putStrLnColor sgrs s = do
  putStrColor sgrs s
  putStrLn ""

Below are some basic colors.

Basic colors
f:boldWhite
f:boldWhite
boldWhite :: [C.SGR]
boldWhite =
  [ C.SetColor C.Foreground C.Vivid C.White,
    C.SetConsoleIntensity C.BoldIntensity
  ]

11 Common utility functions

These utility functions are used by multiple modules, not just the CLI. But we place them here because they deal with IO.

module:Lilac.Util
🎯 src/Lilac/Util.hs
module Lilac.Util
  ( readFrom,
    readFileRobustly,
    writeFileRobustly,
    writeOrWarn,
  )
where

import Control.Exception (catch)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Text.IO qualified as T
import Relude
  ( Bool (True),
    FilePath,
    IO,
    Text,
    otherwise,
    pure,
    putStrLn,
    show,
    stderr,
    ($),
    (<$>),
    (<>),
    (==),
  )
import System.Directory.OsPath qualified as D
import System.File.OsPath qualified as P.IO
import System.IO.Error (IOError)
import System.OsPath (OsPath)
import System.OsPath qualified as P

f:readFrom
f:readFileRobustly
f:writeFileRobustly
f:writeOrWarn

f:readFrom reads a path from the given prefix, and returns a Text.

f:readFrom
readFrom :: FilePath -> FilePath -> IO Text
readFrom prefix path = do
  let fullPath = P.unsafeEncodeUtf $ prefix <> path
  TE.decodeUtf8 <$> P.IO.readFile' fullPath

The functions f:readFileRobustly and f:writeFileRobustly are able to handle errors. This helps us to avoid crashing the program if a path doesn't exist, for example.

f:readFileRobustly
readFileRobustly :: OsPath -> IO Text
readFileRobustly path
  | P.unpack path == [] = pure ""
  | otherwise = do
      catch
        (TE.decodeUtf8 <$> P.IO.readFile' path)
        readHandler
  where
    readHandler :: IOError -> IO Text
    readHandler _ = pure ""

For writing, the main thing f:writeFileRobustly will do is create paths (directories) if they are missing. If the write operation itself otherwise fails, we print an error message but otherwise do nothing.

f:writeFileRobustly
writeFileRobustly :: OsPath -> Text -> IO ()
writeFileRobustly path contentToWrite = do
  D.createDirectoryIfMissing True $ P.takeDirectory path
  catch (P.IO.writeFile' path $ TE.encodeUtf8 contentToWrite) writeHandler
  where
    writeHandler :: IOError -> IO ()
    writeHandler e = putStrLn $ "writeFileRobustly: " <> show e

12 Footnotes

1. Whether or not you want to track your HTML artifacts generally depends on your deployment situation. For example, if you are hosting on SourceHut, you don't need to track these artifacts because you can publish by uploading a tarball of them. On the other hand, if you are hosting on GitHub Pages, you need to upload a repo that has these artifacts so you should track the artifacts (either in the same repo or another one). ↑ ¶ (Cell 146)

Page metrics

Tangled files (3)

  1. bin/Main.hs
  2. src/Lilac/Util.hs
  3. src/Lilac/Version.hs

Named cells (70)

  1. Basic colors
  2. Footnote (fn:whether-to-track-html)
  3. Option handling
  4. data:ArchiveOpts
  5. data:CompileOpts
  6. data:GlobalOpts
  7. data:HtmlHead
  8. data:InitOpts
  9. data:LintOpts
  10. data:OptionHandler
  11. data:ProjectConf
  12. data:RawProjectConf
  13. data:ServeOpts
  14. data:Subcommand
  15. data:TangleOpts
  16. data:WeaveOpts
  17. f:archiveOptsHandler
  18. f:boldWhite
  19. f:bootstrapLilac
  20. f:compileOptsHandler
  21. f:diffSorted
  22. f:emptyProjectConf
  23. f:getEnv
  24. f:getGitVersion
  25. f:gitLsFiles
  26. f:globalOptionsHandler
  27. f:initOptsHandler
  28. f:lilac
  29. f:lilac-main
  30. f:lilacArchive
  31. f:lilacCompile
  32. f:lilacInit
  33. f:lilacJs
  34. f:lilacLint
  35. f:lilacServe
  36. f:lilacTangle
  37. f:lilacVersion
  38. f:lilacWeave
  39. f:lintOptsHandler
  40. f:mkIndexOrg
  41. f:parseProjectConf
  42. f:parseRawProjectConf
  43. f:putStrColor
  44. f:putStrLnColor
  45. f:readFileRobustly
  46. f:readFrom
  47. f:readGPath
  48. f:readOsPath
  49. f:readProjectConf
  50. f:serveOptsHandler
  51. f:subcommandHandler
  52. f:tangle
  53. f:tangleOptsHandler
  54. f:tryLilacGitVersion
  55. f:tryLilacProjectRoot
  56. f:versionFallback
  57. f:weaveOptsHandler
  58. f:weaveToDisk
  59. f:writeFileRobustly
  60. f:writeOrWarn
  61. module:Lilac.Util
  62. module:Lilac.Version
  63. module:Main
  64. text:Lilac.toml
  65. text:Lilac.toml-htmlHead
  66. text:index.org
  67. text:index.org-after-Lilac.toml
  68. text:source-fonts.css
  69. text:vendor-mathjax
  70. text:vendor-source-fonts