From cae12ef4c0db4f63fa8c24eeea8bcd414ac66684 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Sun, 5 Oct 2025 15:17:57 +0200 Subject: [PATCH 1/4] Added picture support --- src/Lexer.hs | 39 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/src/Lexer.hs b/src/Lexer.hs index 77fc84a..9de2255 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Lexer ( Token (..), @@ -7,7 +8,7 @@ module Lexer ( ) where -import Control.Monad (mfilter, void) +import Control.Monad (guard, mfilter, void) import Data.Char (ord, toLower) import Data.Functor (($>)) import Data.Text (Text, intercalate) @@ -62,6 +63,7 @@ data Token | Module Text | QuoteOpen | QuoteClose + | Picture {href :: Text, altText :: Maybe Text} | Space | EOF deriving (Eq, Show) @@ -90,6 +92,7 @@ lexText = go , escape -- maths go before escape to avoid mismatch , headers , newlineToken + , pictures , spaceToken , link , labeledLink @@ -127,6 +130,14 @@ headers = , header6 ] +pictures :: Parser [LocatedToken] +pictures = + choice $ + Parsec.try + <$> [ picture + , markdownPicture + ] + anyUntil :: Parser a -> Parser Text anyUntil p = Text.pack <$> manyTill anyChar (lookAhead p) @@ -177,6 +188,27 @@ anchor = do x <- located $ between "#" "#" (Anchor <$> anyUntil "#") pure [x] +picture :: Lexer +picture = do + void $ string "<<" + pos <- getPosition + href <- anyUntil (string " " <|> string ">>") + altText <- optionMaybe do + void $ many1 space + anyUntil ">>" + void (string ">>") + pure [(pos, Picture{..})] + +markdownPicture :: Lexer +markdownPicture = do + void $ string "![" + pos <- getPosition + altText <- optionMaybe $ anyUntil "](" + void $ string "](" + href <- anyUntil ")" + void $ string ")" + pure [(pos, Picture{..})] + moduleNames :: Parser Text moduleNames = intercalate "." . fmap Text.pack <$> upperId `sepBy1` char '.' @@ -286,8 +318,9 @@ other = do pos <- getPosition c <- takeWhile1_ isUnicodeAlphaNum pure . pure $ (pos, Token c) - where - isUnicodeAlphaNum c = isPrint c && not (isControl c) && not (isSpace c) + +isUnicodeAlphaNum :: Char -> Bool +isUnicodeAlphaNum c = isPrint c && not (isControl c) && not (isSpace c) spaceToken :: Lexer spaceToken = do -- 2.49.1 From 471de1c68ad9797d99d9cc51097d72e6ca52668f Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Sun, 5 Oct 2025 15:19:24 +0200 Subject: [PATCH 2/4] Tests --- test/Spec.hs | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 2040e2f..c75e68a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultilineStrings #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -18,18 +19,20 @@ main = hspec $ do describe "minimal" do it "handles unicode" unicode it "escapes" escaping + it "images" images it "maths" math + it "numeric entity" numericEntity + it "monospace" monospace + it "code blocks" codeBlocks it "anchors" anchor it "space chars" space it "bare string" someString it "emphasis" emphatic - it "monospace" monospace it "labeled link" labeledLink it "markdown link" link it "bird tracks" birdTracks it "module names" modules it "quotes" quotes - it "numeric entity" numericEntity it "ignores nesting" ignoreNesting describe "Parser" do @@ -42,6 +45,18 @@ main = hspec $ do -- Tests ------------ +images :: Expectation +images = do + "<>" + `shouldLexTo` [ (1, 3, Picture "image.png" Nothing) + ] + "<>" + `shouldLexTo` [ (1, 3, Picture "image.png" (Just "title text")) + ] + "![alt text](image.png)" + `shouldLexTo` [ (1, 3, Picture "image.png" (Just "alt text")) + ] + modules :: Expectation modules = do "\"MyModule.Name\"" @@ -165,6 +180,18 @@ numericEntity = do `shouldLexTo` [ (1, 1, NumericEntity 101) ] +codeBlocks :: Expectation +codeBlocks = + """ + @ + func call here + @ + """ + `shouldLexTo` [ (1, 1, MonospaceOpen) + , (1, 2, Token "\nfunc call here\n") + , (3, 1, MonospaceClose) + ] + monospace :: Expectation monospace = "@mono@" -- 2.49.1 From 43be9e3f7f96f0ab426873c194e690349c3205b2 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Sun, 5 Oct 2025 16:45:04 +0200 Subject: [PATCH 3/4] lex: expressions --- src/Lexer.hs | 19 ++++++++++++++++++- test/Spec.hs | 51 +++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 61 insertions(+), 9 deletions(-) diff --git a/src/Lexer.hs b/src/Lexer.hs index 9de2255..a43c034 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -43,6 +43,8 @@ data Token | Escape | EmphasisOpen | EmphasisClose + | Expression + | ResultLine Text | Header Level | MonospaceOpen | MonospaceClose @@ -102,6 +104,7 @@ lexText = go , textElement , quotes , birdTrack + , expression , other ] rest <- go @@ -164,6 +167,11 @@ delimitedSymmetric s = delimited s s eol :: Parser () eol = void "\n" <|> void "\r\n" <|> Parsec.eof +sol :: Parser () +sol = do + pos <- getPosition + guard $ sourceColumn pos == 1 + header1 :: Lexer header1 = delimitedNoTrailing "= " eol (Header One) @@ -272,7 +280,16 @@ mathInline :: Lexer mathInline = delimited "\\(" "\\)" MathInlineOpen MathInlineClose birdTrack :: Lexer -birdTrack = delimitedNoTrailing ">> " eol BirdTrack +birdTrack = sol *> delimitedNoTrailing ">> " eol BirdTrack + +expression :: Lexer +expression = do + exprs <- sol *> delimitedNoTrailing ">>> " eol Expression + results <- manyTill resultLine endOfResults + pure $ exprs <> results + where + endOfResults = lookAhead $ void newline <|> eof + resultLine = located $ ResultLine <$> (anyUntil eol <* eol) escape :: Lexer escape = delimitedNoTrailing "\\" eol Escape diff --git a/test/Spec.hs b/test/Spec.hs index c75e68a..2794072 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -18,20 +18,23 @@ main = hspec $ do describe "Lexer" do describe "minimal" do it "handles unicode" unicode - it "escapes" escaping + it "emphasis" emphatic + it "bold" bolded + it "monospace" monospace + it "module names" modules + it "labeled link" labeledLink + it "markdown link" link + it "anchors" anchor it "images" images it "maths" math it "numeric entity" numericEntity - it "monospace" monospace it "code blocks" codeBlocks - it "anchors" anchor + it "bird tracks" birdTracks + it "expressions" expressions + + it "escapes" escaping it "space chars" space it "bare string" someString - it "emphasis" emphatic - it "labeled link" labeledLink - it "markdown link" link - it "bird tracks" birdTracks - it "module names" modules it "quotes" quotes it "ignores nesting" ignoreNesting @@ -142,6 +145,30 @@ ignoreNesting = `shouldLexTo` [ (1, 1, Token ">/foo/") ] +expressions :: Expectation +expressions = do + """ + >>> expression + result line 1 + result line 2 + + """ + `shouldLexTo` [ (1, 1, Expression) + , (1, 5, Token "expression") + , (2, 1, ResultLine "result line 1") + , (3, 1, ResultLine "result line 2") + ] + """ + >>> expression + result line 3 + result line 4 + """ + `shouldLexTo` [ (1, 1, Expression) + , (1, 5, Token "expression") + , (2, 1, ResultLine "result line 3") + , (3, 1, ResultLine "result line 4") + ] + birdTracks :: Expectation birdTracks = ">> code" @@ -200,6 +227,14 @@ monospace = , (1, 6, MonospaceClose) ] +bolded :: Expectation +bolded = + "__bold text__" + `shouldLexTo` [ (1, 1, BoldOpen) + , (1, 3, Token "bold text") + , (1, 12, BoldClose) + ] + emphatic :: Expectation emphatic = "/emphatic/" -- 2.49.1 From 36e1955f06d87319d867fabe88e5f8cc45e0a5a0 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Sun, 5 Oct 2025 18:43:21 +0200 Subject: [PATCH 4/4] Updated dockerfile. --- Dockerfile | 35 ++++++++++------------------------- 1 file changed, 10 insertions(+), 25 deletions(-) diff --git a/Dockerfile b/Dockerfile index c2919c5..5c84af4 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,36 +1,21 @@ -FROM haskell:9.10.2-bullseye AS builder - -RUN apt-get update && apt-get install -y curl git && rm -rf /var/lib/apt/lists/* - -RUN curl -fsSL https://deb.nodesource.com/setup_22.x | bash - && \ - apt-get install -y nodejs && \ - rm -rf /var/lib/apt/lists/* - -RUN cabal update && \ - cabal install --install-method=copy --installdir=/usr/local/bin \ - fourmolu hlint cabal-gild - -WORKDIR /workspace - -FROM haskell:9.10.2-bullseye +FROM haskell:9.12.2-slim-bookworm RUN apt-get update && apt-get install -y \ - libgmp10 \ curl \ + git \ + libgmp10 \ && rm -rf /var/lib/apt/lists/* +# Install Node.js RUN curl -fsSL https://deb.nodesource.com/setup_22.x | bash - && \ apt-get install -y nodejs && \ rm -rf /var/lib/apt/lists/* -RUN cabal update - -COPY --from=builder /usr/local/bin/cabal /usr/local/bin/ -COPY --from=builder /usr/local/bin/fourmolu /usr/local/bin/ -COPY --from=builder /usr/local/bin/hlint /usr/local/bin/ -COPY --from=builder /usr/local/bin/cabal-gild /usr/local/bin/ +# Install Haskell tools +RUN cabal update && \ + cabal install --install-method=copy --installdir=/usr/local/bin \ + fourmolu hlint cabal-gild && \ + rm -rf ~/.cabal/packages ~/.cabal/store WORKDIR /workspace - -CMD [ "bash" ] - +CMD ["bash"] -- 2.49.1