Compare commits

..

4 commits

Author SHA1 Message Date
36e1955f06 Updated dockerfile.
Some checks failed
Haskell CI / build (pull_request) Failing after 2m50s
Haskell CI / test (pull_request) Has been skipped
Haskell CI / fourmolu (pull_request) Has been skipped
Haskell CI / hlint (pull_request) Has been skipped
2025-10-05 18:43:21 +02:00
43be9e3f7f lex: expressions
Some checks failed
Haskell CI / build (pull_request) Failing after 2m37s
Haskell CI / test (pull_request) Has been skipped
Haskell CI / fourmolu (pull_request) Has been skipped
Haskell CI / hlint (pull_request) Has been skipped
2025-10-05 16:45:04 +02:00
471de1c68a Tests
Some checks failed
Haskell CI / build (pull_request) Failing after 2m26s
Haskell CI / test (pull_request) Has been skipped
Haskell CI / fourmolu (pull_request) Has been skipped
Haskell CI / hlint (pull_request) Has been skipped
2025-10-05 15:19:24 +02:00
cae12ef4c0 Added picture support
All checks were successful
Haskell CI / build (pull_request) Successful in 2m54s
Haskell CI / test (pull_request) Successful in 2m29s
Haskell CI / fourmolu (pull_request) Successful in 6s
Haskell CI / hlint (pull_request) Successful in 6s
2025-10-05 15:17:57 +02:00
4 changed files with 134 additions and 38 deletions

View file

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

View file

@ -12,7 +12,6 @@ pkgs.mkShell rec {
with pkgs;
[
haskell.packages.ghc912.ghc
haskell.packages.ghc912.haskell-language-server
zlib
]
++ map haskell.lib.justStaticExecutables [

View file

@ -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

View file

@ -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/"