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 (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:putStrLnColor2 main entrypoint
In Haskell, like C, execution starts with the main function.
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.
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 initOptsBefore 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).
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: " <> maybeOsPathAnother helper is a parser for newtype:GPath, whose type we need for data:Archive.
readGPath :: ReadM GPath
readGPath = encodeGPath =<< strNotice 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.
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:
- name
- 🔗 1 Name of the project. This is used in the Navigation bar.
- version
- 🔗 4 Human-friendly version information. This is used in the Navigation bar.
Essentially this is Lilac's equivalent of the org-cite-global-bibliography variable in Emacs. See f:docMetaParser and f:prepareCitations for more information.
- htmlHead
- 🔗 8 Allows customization of the HTML <head> element, enough to make Lilac's HTML assets completely static (no dependencies on external CDNs). See HTML <head> customization.
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.
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.
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 RawProjectConfAll keys are expected, except those that use Maybe. So citationStyle 11 is optional.
parseRawProjectConf :: Text -> Either String RawProjectConf
parseRawProjectConf input =
case Toml.decode input of
Failure errs -> Left ("TOML Error:\n" <> intercalate "\n" errs)
Success _ c -> Right cf:parseProjectConf relies on f:parseRawProjectConf for the initial parse, and some additional helpers like N.parseURI.
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.
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).
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.
type Subcommand :: Type
data Subcommand
= ComCompile CompileOpts
| ComArchive ArchiveOpts
| ComTangle TangleOpts
| ComWeave WeaveOpts
| ComLint LintOpts
| ComServe ServeOpts
| ComInit InitOptsEach 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).
type OptionHandler :: Type -> Type
type OptionHandler = Options.Applicative.ParserLet'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).
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.
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).
type CompileOpts :: Type
data CompileOpts = CompileOpts
{ inputs :: [OsPath]
}The inputs option just takes a list of paths to Org files.
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).
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 obj4 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).
type ArchiveOpts :: Type
data ArchiveOpts = ArchiveOpts
{ inputs :: [GPath],
outFile :: OsPath
}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.
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.
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.
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.
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 putStrLnIn 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.
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 putStrLnMost 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:RawProjectConfig → 1 to see how these excluded pathspecs are defined).
The inputs 15 are paths to archive files.
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.
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
_ -> Nothingf:readProjectConf reads the project configuration, which houses (among other things) the list of non-tangled pathspecs toml:RawProjectConfig → 1
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 projectConff:gitLsFiles passes the pathspec arguments from toml:RawProjectConfig → 1.
gitLsFiles :: [Text] -> IO LByteString
gitLsFiles pathspecs = do
let args = ["ls-files", "--", "."] <> (map T.unpack pathspecs)
config = proc "git" args
readProcessStdout_ configf:diffSorted Takes two sorted lists and returns a list of differences. False means tangled, but not tracked. True means tracked, but not tangled.
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) ys6 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.
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).
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.
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.
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 : accUnlike 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.
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.
type ServeOpts :: Type
data ServeOpts = ServeOpts
{ dir :: OsPath,
port :: Int
}f:serveOptsHandler performs some additional validation on the provided options.
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.
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 -- 228 Initialization
The init command can be used to create a basic starter set of files for using Lilac.
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).
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:
index.org: Needed as the first (root) Lilac file. You can think of this as the README of a project.
Lilac.toml: Needed for using Lilac.
Makefile: Useful for writing down the exact Lilac incantations to get what you want.
.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.
.gitattributes: Useful for suppressing the diff of woven artifacts (if you decide to track these artifacts in version control1).
.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.
vendor-mathjax.sh: (Optional) Used to vendor (download) MathJax locally.
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.
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 -- 27f:writeOrWarn 24 uses f:writeFileRobustly to either write the file content or skip if the file path already exists.
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 contentToWritef:mkIndexOrg 26 constructs the all-important index.org file.
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).
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.1 Lilac.toml
text:Lilac.toml is a basic template; the user is expected to tweak this file first (inside the index.org file).
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.
[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.
#+title: Introduction
Modify this file to suit your project's needs.
* Lilac configuration
#+header: :tangle Lilac.toml
#+begin_src toml
text:Lilac.tomltext: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.
#+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_src8.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.
** 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_src8.2.2 Source family of fonts
We download variable weight fonts to keep things lightweight.
** 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_srcHaving 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).
@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
( 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:getEnvThe 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.
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 <$> getZonedTimeIn 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.
getGitVersion :: IO String
getGitVersion = evalContT $ callCC $ \escapeWith -> do
tryLilacGitVersion escapeWith
tryLilacProjectRoot escapeWith
versionFallbackThe 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.
tryLilacGitVersion :: (MonadTrans t) => (String -> t IO ()) -> t IO ()
tryLilacGitVersion escapeWith = do
gitVersion <- lift $ getEnv "LILAC_GIT_VERSION"
when (not $ null gitVersion) $ escapeWith gitVersiongetEnv looks up an environment variable, but returns the empty string if the environment variable was not found.
getEnv :: String -> IO String
getEnv env = fromMaybe "" <$> lookupEnv envThat'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.
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 gitOutputLastly 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.
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.
putStrColor :: [C.SGR] -> String -> IO ()
putStrColor sgrs s = do
C.setSGR sgrs
putStr s
C.setSGR [C.Reset]putStrLnColor :: [C.SGR] -> String -> IO ()
putStrLnColor sgrs s = do
putStrColor sgrs s
putStrLn ""Below are some basic colors.
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
( 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:writeOrWarnf:readFrom reads a path from the given prefix, and returns a Text.
readFrom :: FilePath -> FilePath -> IO Text
readFrom prefix path = do
let fullPath = P.unsafeEncodeUtf $ prefix <> path
TE.decodeUtf8 <$> P.IO.readFile' fullPathThe 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.
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.
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 e12 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)
Backlinks (26)
Named cells (70)
- Basic colors
- Footnote (fn:whether-to-track-html)
- Option handling
- data:ArchiveOpts
- data:CompileOpts
- data:GlobalOpts
- data:HtmlHead
- data:InitOpts
- data:LintOpts
- data:OptionHandler
- data:ProjectConf
- data:RawProjectConf
- data:ServeOpts
- data:Subcommand
- data:TangleOpts
- data:WeaveOpts
- f:archiveOptsHandler
- f:boldWhite
- f:bootstrapLilac
- f:compileOptsHandler
- f:diffSorted
- f:emptyProjectConf
- f:getEnv
- f:getGitVersion
- f:gitLsFiles
- f:globalOptionsHandler
- f:initOptsHandler
- f:lilac
- f:lilac-main
- f:lilacArchive
- f:lilacCompile
- f:lilacInit
- f:lilacJs
- f:lilacLint
- f:lilacServe
- f:lilacTangle
- f:lilacVersion
- f:lilacWeave
- f:lintOptsHandler
- f:mkIndexOrg
- f:parseProjectConf
- f:parseRawProjectConf
- f:putStrColor
- f:putStrLnColor
- f:readFileRobustly
- f:readFrom
- f:readGPath
- f:readOsPath
- f:readProjectConf
- f:serveOptsHandler
- f:subcommandHandler
- f:tangle
- f:tangleOptsHandler
- f:tryLilacGitVersion
- f:tryLilacProjectRoot
- f:versionFallback
- f:weaveOptsHandler
- f:weaveToDisk
- f:writeFileRobustly
- f:writeOrWarn
- module:Lilac.Util
- module:Lilac.Version
- module:Main
- text:Lilac.toml
- text:Lilac.toml-htmlHead
- text:index.org
- text:index.org-after-Lilac.toml
- text:source-fonts.css
- text:vendor-mathjax
- text:vendor-source-fonts