Compare commits
4 commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 36e1955f06 | |||
| 43be9e3f7f | |||
| 471de1c68a | |||
| cae12ef4c0 |
4 changed files with 134 additions and 38 deletions
33
Dockerfile
33
Dockerfile
|
|
@ -1,36 +1,21 @@
|
||||||
FROM haskell:9.10.2-bullseye AS builder
|
FROM haskell:9.12.2-slim-bookworm
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
RUN apt-get update && apt-get install -y \
|
RUN apt-get update && apt-get install -y \
|
||||||
libgmp10 \
|
|
||||||
curl \
|
curl \
|
||||||
|
git \
|
||||||
|
libgmp10 \
|
||||||
&& rm -rf /var/lib/apt/lists/*
|
&& rm -rf /var/lib/apt/lists/*
|
||||||
|
|
||||||
|
# Install Node.js
|
||||||
RUN curl -fsSL https://deb.nodesource.com/setup_22.x | bash - && \
|
RUN curl -fsSL https://deb.nodesource.com/setup_22.x | bash - && \
|
||||||
apt-get install -y nodejs && \
|
apt-get install -y nodejs && \
|
||||||
rm -rf /var/lib/apt/lists/*
|
rm -rf /var/lib/apt/lists/*
|
||||||
|
|
||||||
RUN cabal update
|
# Install Haskell tools
|
||||||
|
RUN cabal update && \
|
||||||
COPY --from=builder /usr/local/bin/cabal /usr/local/bin/
|
cabal install --install-method=copy --installdir=/usr/local/bin \
|
||||||
COPY --from=builder /usr/local/bin/fourmolu /usr/local/bin/
|
fourmolu hlint cabal-gild && \
|
||||||
COPY --from=builder /usr/local/bin/hlint /usr/local/bin/
|
rm -rf ~/.cabal/packages ~/.cabal/store
|
||||||
COPY --from=builder /usr/local/bin/cabal-gild /usr/local/bin/
|
|
||||||
|
|
||||||
WORKDIR /workspace
|
WORKDIR /workspace
|
||||||
|
|
||||||
CMD ["bash"]
|
CMD ["bash"]
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -12,7 +12,6 @@ pkgs.mkShell rec {
|
||||||
with pkgs;
|
with pkgs;
|
||||||
[
|
[
|
||||||
haskell.packages.ghc912.ghc
|
haskell.packages.ghc912.ghc
|
||||||
haskell.packages.ghc912.haskell-language-server
|
|
||||||
zlib
|
zlib
|
||||||
]
|
]
|
||||||
++ map haskell.lib.justStaticExecutables [
|
++ map haskell.lib.justStaticExecutables [
|
||||||
|
|
|
||||||
56
src/Lexer.hs
56
src/Lexer.hs
|
|
@ -1,4 +1,5 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
|
||||||
module Lexer (
|
module Lexer (
|
||||||
Token (..),
|
Token (..),
|
||||||
|
|
@ -7,7 +8,7 @@ module Lexer (
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Monad (mfilter, void)
|
import Control.Monad (guard, mfilter, void)
|
||||||
import Data.Char (ord, toLower)
|
import Data.Char (ord, toLower)
|
||||||
import Data.Functor (($>))
|
import Data.Functor (($>))
|
||||||
import Data.Text (Text, intercalate)
|
import Data.Text (Text, intercalate)
|
||||||
|
|
@ -42,6 +43,8 @@ data Token
|
||||||
| Escape
|
| Escape
|
||||||
| EmphasisOpen
|
| EmphasisOpen
|
||||||
| EmphasisClose
|
| EmphasisClose
|
||||||
|
| Expression
|
||||||
|
| ResultLine Text
|
||||||
| Header Level
|
| Header Level
|
||||||
| MonospaceOpen
|
| MonospaceOpen
|
||||||
| MonospaceClose
|
| MonospaceClose
|
||||||
|
|
@ -62,6 +65,7 @@ data Token
|
||||||
| Module Text
|
| Module Text
|
||||||
| QuoteOpen
|
| QuoteOpen
|
||||||
| QuoteClose
|
| QuoteClose
|
||||||
|
| Picture {href :: Text, altText :: Maybe Text}
|
||||||
| Space
|
| Space
|
||||||
| EOF
|
| EOF
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
@ -90,6 +94,7 @@ lexText = go
|
||||||
, escape -- maths go before escape to avoid mismatch
|
, escape -- maths go before escape to avoid mismatch
|
||||||
, headers
|
, headers
|
||||||
, newlineToken
|
, newlineToken
|
||||||
|
, pictures
|
||||||
, spaceToken
|
, spaceToken
|
||||||
, link
|
, link
|
||||||
, labeledLink
|
, labeledLink
|
||||||
|
|
@ -99,6 +104,7 @@ lexText = go
|
||||||
, textElement
|
, textElement
|
||||||
, quotes
|
, quotes
|
||||||
, birdTrack
|
, birdTrack
|
||||||
|
, expression
|
||||||
, other
|
, other
|
||||||
]
|
]
|
||||||
rest <- go
|
rest <- go
|
||||||
|
|
@ -127,6 +133,14 @@ headers =
|
||||||
, header6
|
, header6
|
||||||
]
|
]
|
||||||
|
|
||||||
|
pictures :: Parser [LocatedToken]
|
||||||
|
pictures =
|
||||||
|
choice $
|
||||||
|
Parsec.try
|
||||||
|
<$> [ picture
|
||||||
|
, markdownPicture
|
||||||
|
]
|
||||||
|
|
||||||
anyUntil :: Parser a -> Parser Text
|
anyUntil :: Parser a -> Parser Text
|
||||||
anyUntil p = Text.pack <$> manyTill anyChar (lookAhead p)
|
anyUntil p = Text.pack <$> manyTill anyChar (lookAhead p)
|
||||||
|
|
||||||
|
|
@ -153,6 +167,11 @@ delimitedSymmetric s = delimited s s
|
||||||
eol :: Parser ()
|
eol :: Parser ()
|
||||||
eol = void "\n" <|> void "\r\n" <|> Parsec.eof
|
eol = void "\n" <|> void "\r\n" <|> Parsec.eof
|
||||||
|
|
||||||
|
sol :: Parser ()
|
||||||
|
sol = do
|
||||||
|
pos <- getPosition
|
||||||
|
guard $ sourceColumn pos == 1
|
||||||
|
|
||||||
header1 :: Lexer
|
header1 :: Lexer
|
||||||
header1 = delimitedNoTrailing "= " eol (Header One)
|
header1 = delimitedNoTrailing "= " eol (Header One)
|
||||||
|
|
||||||
|
|
@ -177,6 +196,27 @@ anchor = do
|
||||||
x <- located $ between "#" "#" (Anchor <$> anyUntil "#")
|
x <- located $ between "#" "#" (Anchor <$> anyUntil "#")
|
||||||
pure [x]
|
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 ""
|
||||||
|
void $ string ")"
|
||||||
|
pure [(pos, Picture{..})]
|
||||||
|
|
||||||
moduleNames :: Parser Text
|
moduleNames :: Parser Text
|
||||||
moduleNames = intercalate "." . fmap Text.pack <$> upperId `sepBy1` char '.'
|
moduleNames = intercalate "." . fmap Text.pack <$> upperId `sepBy1` char '.'
|
||||||
|
|
||||||
|
|
@ -240,7 +280,16 @@ mathInline :: Lexer
|
||||||
mathInline = delimited "\\(" "\\)" MathInlineOpen MathInlineClose
|
mathInline = delimited "\\(" "\\)" MathInlineOpen MathInlineClose
|
||||||
|
|
||||||
birdTrack :: Lexer
|
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 :: Lexer
|
||||||
escape = delimitedNoTrailing "\\" eol Escape
|
escape = delimitedNoTrailing "\\" eol Escape
|
||||||
|
|
@ -286,7 +335,8 @@ other = do
|
||||||
pos <- getPosition
|
pos <- getPosition
|
||||||
c <- takeWhile1_ isUnicodeAlphaNum
|
c <- takeWhile1_ isUnicodeAlphaNum
|
||||||
pure . pure $ (pos, Token c)
|
pure . pure $ (pos, Token c)
|
||||||
where
|
|
||||||
|
isUnicodeAlphaNum :: Char -> Bool
|
||||||
isUnicodeAlphaNum c = isPrint c && not (isControl c) && not (isSpace c)
|
isUnicodeAlphaNum c = isPrint c && not (isControl c) && not (isSpace c)
|
||||||
|
|
||||||
spaceToken :: Lexer
|
spaceToken :: Lexer
|
||||||
|
|
|
||||||
78
test/Spec.hs
78
test/Spec.hs
|
|
@ -1,3 +1,4 @@
|
||||||
|
{-# LANGUAGE MultilineStrings #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# OPTIONS_GHC -Wno-orphans #-}
|
{-# OPTIONS_GHC -Wno-orphans #-}
|
||||||
|
|
||||||
|
|
@ -17,19 +18,24 @@ main = hspec $ do
|
||||||
describe "Lexer" do
|
describe "Lexer" do
|
||||||
describe "minimal" do
|
describe "minimal" do
|
||||||
it "handles unicode" unicode
|
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 "emphasis" emphatic
|
||||||
|
it "bold" bolded
|
||||||
it "monospace" monospace
|
it "monospace" monospace
|
||||||
|
it "module names" modules
|
||||||
it "labeled link" labeledLink
|
it "labeled link" labeledLink
|
||||||
it "markdown link" link
|
it "markdown link" link
|
||||||
it "bird tracks" birdTracks
|
it "anchors" anchor
|
||||||
it "module names" modules
|
it "images" images
|
||||||
it "quotes" quotes
|
it "maths" math
|
||||||
it "numeric entity" numericEntity
|
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
|
it "ignores nesting" ignoreNesting
|
||||||
|
|
||||||
describe "Parser" do
|
describe "Parser" do
|
||||||
|
|
@ -42,6 +48,18 @@ main = hspec $ do
|
||||||
-- Tests
|
-- 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"))
|
||||||
|
]
|
||||||
|
""
|
||||||
|
`shouldLexTo` [ (1, 3, Picture "image.png" (Just "alt text"))
|
||||||
|
]
|
||||||
|
|
||||||
modules :: Expectation
|
modules :: Expectation
|
||||||
modules = do
|
modules = do
|
||||||
"\"MyModule.Name\""
|
"\"MyModule.Name\""
|
||||||
|
|
@ -127,6 +145,30 @@ ignoreNesting =
|
||||||
`shouldLexTo` [ (1, 1, Token ">/foo/")
|
`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 :: Expectation
|
||||||
birdTracks =
|
birdTracks =
|
||||||
">> code"
|
">> code"
|
||||||
|
|
@ -165,6 +207,18 @@ numericEntity = do
|
||||||
`shouldLexTo` [ (1, 1, NumericEntity 101)
|
`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 :: Expectation
|
||||||
monospace =
|
monospace =
|
||||||
"@mono@"
|
"@mono@"
|
||||||
|
|
@ -173,6 +227,14 @@ monospace =
|
||||||
, (1, 6, MonospaceClose)
|
, (1, 6, MonospaceClose)
|
||||||
]
|
]
|
||||||
|
|
||||||
|
bolded :: Expectation
|
||||||
|
bolded =
|
||||||
|
"__bold text__"
|
||||||
|
`shouldLexTo` [ (1, 1, BoldOpen)
|
||||||
|
, (1, 3, Token "bold text")
|
||||||
|
, (1, 12, BoldClose)
|
||||||
|
]
|
||||||
|
|
||||||
emphatic :: Expectation
|
emphatic :: Expectation
|
||||||
emphatic =
|
emphatic =
|
||||||
"/emphatic/"
|
"/emphatic/"
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue