Skip to content
Snippets Groups Projects
Commit ea892e33 authored by Alice Brenon's avatar Alice Brenon
Browse files

Make glossary use alphabetical order (instead of char code) to make sure...

Make glossary use alphabetical order (instead of char code) to make sure lowercase letters are not put at the end
parent 3603abe8
No related branches found
No related tags found
No related merge requests found
......@@ -4,10 +4,10 @@ import Control.Monad.Reader (MonadReader(..), ReaderT(..), asks, runReaderT)
import Control.Monad.State (MonadState(..), gets, modify, runStateT)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Attoparsec.Text (char, inClass, parseOnly, string, takeWhile1)
import Data.Char (isAlphaNum, isUpper, toLower)
import Data.Char as Char (isAlphaNum, isUpper, toLower)
import Data.Default (def)
import Data.Map as Map (Map, insert, member, toList)
import Data.Text as Text (Text, concat, map, toTitle, unpack)
import Data.Map as Map (Map, insert, elems, member)
import Data.Text as Text (Text, concat, map, toLower, toTitle, unpack)
import Data.Text.IO as Text (readFile)
import System.Exit (die)
import System.FilePath ((</>), (<.>))
......@@ -22,7 +22,10 @@ import Text.Read (readMaybe)
main :: IO ()
main = toJSONFilter withGlossary
type Glossary = Map Text [Block]
data Entry = Entry
{ headword :: Text
, definition :: [Block] }
type Glossary = Map Text Entry
data KnownFormat = Latex | Html deriving (Read, Show)
type RawMaker = (Text, KnownFormat -> [Text]) -> Inline
data Config = Config
......@@ -69,16 +72,20 @@ findDefinitions i = pure i
loadDef :: (MonadIO m, MonadReader Config m, MonadState Glossary m) =>
Text -> Bool -> m Inline
loadDef t True = raw link t
loadDef t _ = do
Pandoc _ definition <- getDocument =<< asks ((</> unpack t <.> "md") . root)
modify $ insert t [] -- set a (temporary) empty definition for the term to avoid loops
modify . insert t =<< walkM findDefinitions definition
loadDef t True
loadDef headword True = raw link headword
loadDef headword _ = do
Pandoc _ definitionBody <- getDocument =<< asks definitionPath
store empty -- set a (temporary) empty definition for the term to avoid loops
definition <- walkM findDefinitions definitionBody
store $ Entry {headword, definition}
loadDef headword True
where
definitionPath = ((</> unpack headword <.> "md") . root)
getDocument path =
liftIO (Text.readFile path >>= runIOorExplode . readMarkdown options)
options = def { readerExtensions = pandocExtensions }
empty = Entry {headword = "", definition = []}
store = modify . insert (Text.toLower headword)
addGlossarySection :: MonadReader Config m => ([Block], Glossary) -> m [Block]
addGlossarySection (blocks, definitions)
......@@ -88,14 +95,15 @@ addGlossarySection (blocks, definitions)
header (Config {level, title}) =
Header level ("glossary", ["unnumbered"], []) [Str title]
chaptermark = Plain . pure <$> (raw sectionTitle =<< asks title)
body = DefinitionList <$> (mapM entryOf $ Map.toList definitions)
entryOf (key, definition) = (,[definition]) <$> sequence [raw target key]
body = DefinitionList <$> (mapM item $ Map.elems definitions)
item (Entry {headword, definition}) =
(,[definition]) <$> sequence [raw target headword]
labelFor :: Text -> Text
labelFor t = "glossary-" <> Text.map normalize t
where
normalize c
| isUpper c = toLower c
| isUpper c = Char.toLower c
| isAlphaNum c = c
| otherwise = '_'
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment