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"]
-

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)
@@ -42,6 +43,8 @@ data Token
   | Escape
   | EmphasisOpen
   | EmphasisClose
+  | Expression
+  | ResultLine Text
   | Header Level
   | MonospaceOpen
   | MonospaceClose
@@ -62,6 +65,7 @@ data Token
   | Module Text
   | QuoteOpen
   | QuoteClose
+  | Picture {href :: Text, altText :: Maybe Text}
   | Space
   | EOF
   deriving (Eq, Show)
@@ -90,6 +94,7 @@ lexText = go
                   , escape -- maths go before escape to avoid mismatch
                   , headers
                   , newlineToken
+                  , pictures
                   , spaceToken
                   , link
                   , labeledLink
@@ -99,6 +104,7 @@ lexText = go
                   , textElement
                   , quotes
                   , birdTrack
+                  , expression
                   , other
                   ]
         rest <- go
@@ -127,6 +133,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)
 
@@ -153,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)
 
@@ -177,6 +196,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 '.'
 
@@ -240,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
@@ -286,7 +335,8 @@ other = do
   pos <- getPosition
   c <- takeWhile1_ isUnicodeAlphaNum
   pure . pure $ (pos, Token c)
- where
+
+isUnicodeAlphaNum :: Char -> Bool
 isUnicodeAlphaNum c = isPrint c && not (isControl c) && not (isSpace c)
 
 spaceToken :: Lexer

test/Spec.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE MultilineStrings #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -17,19 +18,24 @@ main = hspec $ do
   describe "Lexer" do
     describe "minimal" do
       it "handles unicode" unicode
-      it "escapes" escaping
-      it "maths" math
-      it "anchors" anchor
-      it "space chars" space
-      it "bare string" someString
       it "emphasis" emphatic
+      it "bold" bolded
       it "monospace" monospace
+      it "module names" modules
       it "labeled link" labeledLink
       it "markdown link" link
-      it "bird tracks" birdTracks
-      it "module names" modules
-      it "quotes" quotes
+      it "anchors" anchor
+      it "images" images
+      it "maths" math
       it "numeric entity" numericEntity
+      it "code blocks" codeBlocks
+      it "bird tracks" birdTracks
+      it "expressions" expressions
+
+      it "escapes" escaping
+      it "space chars" space
+      it "bare string" someString
+      it "quotes" quotes
       it "ignores nesting" ignoreNesting
 
   describe "Parser" do
@@ -42,6 +48,18 @@ main = hspec $ do
 -- Tests
 ------------
 
+images :: Expectation
+images = do
+  "<<image.png>>"
+    `shouldLexTo` [ (1, 3, Picture "image.png" Nothing)
+                  ]
+  "<<image.png title text>>"
+    `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\""
@@ -127,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"
@@ -165,6 +207,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@"
@@ -173,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/"