0 | ||| Functions for generating highlighted typst code snippets
  1 | module Katla.Typst
  2 |
  3 | import Core.Metadata
  4 | import System.File
  5 |
  6 | import Collie
  7 | import Katla.Config
  8 |
  9 | %hide Collie.Modifiers.infix.(::=)
 10 |
 11 | export
 12 | escapeTypst : Char -> List Char
 13 | escapeTypst '\n' = ['\\', '\n']
 14 | escapeTypst '\r' = ['\\', '\r']
 15 | escapeTypst '\t' = ['\\', '\t']
 16 | escapeTypst '\\' = ['\\', '\\']
 17 | escapeTypst '"'  = ['\\', '"']
 18 | escapeTypst x    = [x]
 19 |
 20 | export
 21 | annotate : Maybe Decoration -> String -> String
 22 | annotate Nothing    s = "#\"\{s}\""
 23 | annotate (Just dec) s = apply (convert dec) s
 24 |   where
 25 |
 26 |     apply : String -> String -> String
 27 |     apply f a = "#\{f}[#\"\{a}\"]"
 28 |
 29 | export
 30 | typstHeader : Config -> String
 31 | typstHeader cfg =  """
 32 |
 33 | #let IdrisCodeFont        = "\{cfg.font}"
 34 | #let IdrisColourData      = \{cfg.datacons.colour}
 35 | #let IdrisColourType      = \{cfg.typecons.colour}
 36 | #let IdrisColourBound     = \{cfg.bound.colour}
 37 | #let IdrisColourFunction  = \{cfg.function.colour}
 38 | #let IdrisColourKeyword   = \{cfg.keyword.colour}
 39 | #let IdrisColourImplicit  = \{cfg.bound.colour}
 40 | #let IdrisColourComment   = \{cfg.comment.colour}
 41 | #let IdrisColourHole      = \{cfg.hole.colour}
 42 | #let IdrisColourNamespace = \{cfg.namespce.colour}
 43 | #let IdrisColourPostulate = \{cfg.postulte.colour}
 44 | #let IdrisColourModule    = \{cfg.aModule.colour}
 45 |
 46 | #let IdrisHighlight(col, styl, wei, cont) = {
 47 |   set text(fill: col, style: styl, weight: wei)
 48 |   cont
 49 | }
 50 |
 51 | #let IdrisHole(cont) = {
 52 |   set text(fill: IdrisColourHole\{cfg.hole.style})
 53 |   cont
 54 | }
 55 |
 56 | #let IdrisCode(cont) = {
 57 |   set text(font: IdrisCodeFont, size: 0.8em)
 58 |   cont
 59 | }
 60 |
 61 | #let IdrisData(txt)      = IdrisHighlight(IdrisColourData\{cfg.datacons.style},txt)
 62 | #let IdrisType(txt)      = IdrisHighlight(IdrisColourType\{cfg.typecons.style},txt)
 63 | #let IdrisBound(txt)     = IdrisHighlight(IdrisColourBound\{cfg.bound.style},txt)
 64 | #let IdrisFunction(txt)  = IdrisHighlight(IdrisColourFunction\{cfg.function.style},txt)
 65 | #let IdrisKeyword(txt)   = IdrisHighlight(IdrisColourKeyword\{cfg.keyword.style},txt)
 66 | #let IdrisImplicit(txt)  = IdrisHighlight(IdrisColourImplicit\{cfg.bound.style},txt)
 67 | #let IdrisComment(txt)   = IdrisHighlight(IdrisColourComment\{cfg.comment.style},txt)
 68 | #let IdrisNamespace(txt) = IdrisHighlight(IdrisColourNamespace\{cfg.namespce.style},txt)
 69 | #let IdrisPostulate(txt) = IdrisHighlight(IdrisColourPostulate\{cfg.postulte.style},txt)
 70 | #let IdrisModule(txt)    = IdrisHighlight(IdrisColourModule\{cfg.aModule.style},txt)
 71 | """
 72 |
 73 |
 74 | export
 75 | standalonePre : Config -> String
 76 | standalonePre config = ""
 77 |
 78 | export
 79 | makeMacroPre : String -> String
 80 | makeMacroPre name = """
 81 | #IdrisCode[
 82 | """
 83 |
 84 | export
 85 | makeMacroPost : String
 86 | makeMacroPost = """
 87 | ]
 88 | """
 89 |
 90 | export
 91 | makeInlineMacroPre : String -> String
 92 | makeInlineMacroPre name = ""
 93 |
 94 | export
 95 | makeInlineMacroPost : String
 96 | makeInlineMacroPost = ""
 97 |
 98 | export
 99 | mkDriver : Config -> Driver
100 | mkDriver config = MkDriver
101 |   (\_, _ => "", " \\ ")
102 |   escapeTypst
103 |   annotate
104 |   (standalonePre config, "")
105 |   (makeInlineMacroPre, makeInlineMacroPost)
106 |   (makeMacroPre, makeMacroPost)
107 |
108 | preambleExec : (moutput : Maybe String) -> (configFile : Maybe String) -> IO ()
109 | preambleExec moutput configFile = do
110 |   Right file <- maybe (pure $ Right stdout) (flip openFile WriteTruncate) moutput
111 |   | Left err => putStrLn """
112 |               Error while opening preamble file \{maybe "stdout" id moutput}:
113 |               \{show err}
114 |               """
115 |   config <- getConfiguration Typst configFile
116 |   Right () <- fPutStr file $ typstHeader config
117 |   | Left err => putStrLn """
118 |       Error while writing preamble file \{fromMaybe "stdout" moutput}:
119 |       \{show err}
120 |       """
121 |   closeFile file
122 |
123 | public export
124 | preambleCommand : Command "preamble"
125 | preambleCommand = MkCommand
126 |   { description = "Generate Typst preamble to be used in `template.typ`"
127 |   , subcommands = []
128 |   , modifiers =
129 |     [ "--config" ::= option """
130 |         Preamble configuration file in Dhall format.
131 |         Use `init` to generate the defaults config file.
132 |         """
133 |         filePath
134 |     ]
135 |   , arguments = filePath
136 |   }
137 |
138 | export
139 | preamble : (ParsedCommand _ Typst.preambleCommand) -> IO ()
140 | preamble parsed = preambleExec parsed.arguments (parsed.modifiers.project "--config")
141 |
142 | public export
143 | initTypstCommand : Command "init"
144 | initTypstCommand = MkCommand
145 |   { description = "Generate preamble configuration file"
146 |   , subcommands = []
147 |   , modifiers = []
148 |   , arguments = filePath
149 |   }
150 |
151 | export
152 | init : (ParsedCommand _ Typst.initTypstCommand) -> IO ()
153 | init parsed = initExec Typst parsed.arguments
154 |