diff --git a/Dockerfile b/Dockerfile index 5c84af4..c2919c5 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,21 +1,36 @@ -FROM haskell:9.12.2-slim-bookworm +FROM haskell:9.10.2-bullseye AS builder -RUN apt-get update && apt-get install -y \ - curl \ - git \ - libgmp10 \ - && rm -rf /var/lib/apt/lists/* +RUN apt-get update && apt-get install -y curl git && 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/* -# 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 + fourmolu hlint cabal-gild WORKDIR /workspace -CMD ["bash"] + +FROM haskell:9.10.2-bullseye + +RUN apt-get update && apt-get install -y \ + libgmp10 \ + curl \ + && 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 + +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/ + +WORKDIR /workspace + +CMD [ "bash" ] + diff --git a/shell.nix b/shell.nix index d67a849..61a931d 100644 --- a/shell.nix +++ b/shell.nix @@ -12,6 +12,7 @@ pkgs.mkShell rec { with pkgs; [ haskell.packages.ghc912.ghc + haskell.packages.ghc912.haskell-language-server zlib ] ++ map haskell.lib.justStaticExecutables [ diff --git a/src/Lexer.hs b/src/Lexer.hs index a43c034..77fc84a 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} module Lexer ( Token (..), @@ -8,7 +7,7 @@ module Lexer ( ) where -import Control.Monad (guard, mfilter, void) +import Control.Monad (mfilter, void) import Data.Char (ord, toLower) import Data.Functor (($>)) import Data.Text (Text, intercalate) @@ -43,8 +42,6 @@ data Token | Escape | EmphasisOpen | EmphasisClose - | Expression - | ResultLine Text | Header Level | MonospaceOpen | MonospaceClose @@ -65,7 +62,6 @@ data Token | Module Text | QuoteOpen | QuoteClose - | Picture {href :: Text, altText :: Maybe Text} | Space | EOF deriving (Eq, Show) @@ -94,7 +90,6 @@ lexText = go , escape -- maths go before escape to avoid mismatch , headers , newlineToken - , pictures , spaceToken , link , labeledLink @@ -104,7 +99,6 @@ lexText = go , textElement , quotes , birdTrack - , expression , other ] rest <- go @@ -133,14 +127,6 @@ headers = , header6 ] -pictures :: Parser [LocatedToken] -pictures = - choice $ - Parsec.try - <$> [ picture - , markdownPicture - ] - anyUntil :: Parser a -> Parser Text anyUntil p = Text.pack <$> manyTill anyChar (lookAhead p) @@ -167,11 +153,6 @@ 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) @@ -196,27 +177,6 @@ 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 '.' @@ -280,16 +240,7 @@ mathInline :: Lexer mathInline = delimited "\\(" "\\)" MathInlineOpen MathInlineClose birdTrack :: Lexer -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) +birdTrack = delimitedNoTrailing ">> " eol BirdTrack escape :: Lexer escape = delimitedNoTrailing "\\" eol Escape @@ -335,9 +286,8 @@ other = do pos <- getPosition c <- takeWhile1_ isUnicodeAlphaNum pure . pure $ (pos, Token c) - -isUnicodeAlphaNum :: Char -> Bool -isUnicodeAlphaNum c = isPrint c && not (isControl c) && not (isSpace c) + where + isUnicodeAlphaNum c = isPrint c && not (isControl c) && not (isSpace c) spaceToken :: Lexer spaceToken = do diff --git a/test/Spec.hs b/test/Spec.hs index 2794072..2040e2f 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE MultilineStrings #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -18,24 +17,19 @@ main = hspec $ do describe "Lexer" do describe "minimal" do it "handles unicode" unicode - 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 "code blocks" codeBlocks - it "bird tracks" birdTracks - it "expressions" expressions - it "escapes" escaping + it "maths" math + 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 @@ -48,18 +42,6 @@ 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\"" @@ -145,30 +127,6 @@ 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" @@ -207,18 +165,6 @@ 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@" @@ -227,14 +173,6 @@ 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/"