From 9db8fd395737338fd6ff4ce925b7e554bfff5e4d Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Sat, 27 Sep 2025 09:27:30 +0200 Subject: [PATCH] Improved makefile, formatting --- Makefile | 41 +++++++++++++++++++++-- src/Lexer.hs | 4 +-- src/Parser/Util.hs | 4 ++- src/Types.hs | 83 ++++++++++++++++++++++++---------------------- test/Spec.hs | 17 +++++----- 5 files changed, 94 insertions(+), 55 deletions(-) diff --git a/Makefile b/Makefile index 62cad36..6bc9ca2 100644 --- a/Makefile +++ b/Makefile @@ -1,9 +1,44 @@ .PHONY: help -help: ## Show this help. +help: ## Show this help @grep -E '^[a-zA-Z_-]+:.*?## .*$$' $(MAKEFILE_LIST) | sort | awk 'BEGIN {FS = ":.*?## "}; {printf "\033[36m%-30s\033[0m %s\n", $$1, $$2}' -.PHONY: format -format: +.PHONY: build +build: ## Build the project + cabal build + +.PHONY: test +test: ## Run tests + cabal test --test-show-details=direct + +.PHONY: clean +clean: ## Clean build artifacts + cabal clean + +.PHONY: fourmolu +fourmolu: ## Format Haskell code find . -type f -name "*.hs" ! -path "./dist-newstyle/*" -exec fourmolu -i {} + + +.PHONY: fourmolu-check +fourmolu-check: ## Check if code is formatted + find . -type f -name "*.hs" ! -path "./dist-newstyle/*" -exec fourmolu --mode check {} \; + +.PHONY: lint +lint: ## Run hlint + hlint src test app + +.PHONY: cabal-gild +cabal-gild: ## Format cabal file cabal-gild --io=haddock2.cabal +.PHONY: format +format: fourmolu cabal-gild ## Run all formatters + +.PHONY: check +check: fourmolu-check lint ## Run all checks (CI-style) + +.PHONY: ci +ci: build test check ## Run full CI pipeline locally + +.PHONY: docs +docs: ## Generate documentation + cabal haddock --haddock-hyperlink-source diff --git a/src/Lexer.hs b/src/Lexer.hs index 4a85fb5..84a8373 100644 --- a/src/Lexer.hs +++ b/src/Lexer.hs @@ -69,7 +69,7 @@ located :: Parser a -> Parser (SourcePos, a) located p = (,) <$> getPosition <*> p tokenise :: [Parser a] -> Parser [(SourcePos, a)] -tokenise = sequence . map located +tokenise = mapM located lexer :: String -> Either ParseError [LocatedToken] lexer = Parsec.runParser lexText initialParserState "input" . Text.pack @@ -146,7 +146,7 @@ delimitedNoTrailing openP closeP openTok = asList <$> delimitedAsTuple (openTok asList (a, tok, _) = [a, tok] delimitedSymmetric :: Parser a -> Token -> Token -> Parser [LocatedToken] -delimitedSymmetric s t1 t2 = delimited s s t1 t2 +delimitedSymmetric s = delimited s s eol :: Parser () eol = void "\n" <|> void "\r\n" <|> Parsec.eof diff --git a/src/Parser/Util.hs b/src/Parser/Util.hs index 4cf96cb..a75fcef 100644 --- a/src/Parser/Util.hs +++ b/src/Parser/Util.hs @@ -13,7 +13,9 @@ import Text.Parsec.Pos (updatePosChar) Return everything consumed except for the end pattern itself. -} takeUntil :: Text -> Parser Text -takeUntil end_ = Text.dropEnd (Text.length end_) <$> requireEnd (scan p (False, end)) >>= gotSome +takeUntil end_ = + requireEnd (scan p (False, end)) + >>= gotSome . Text.dropEnd (Text.length end_) where end = Text.unpack end_ diff --git a/src/Types.hs b/src/Types.hs index a41e38b..ec7a4e4 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -9,6 +9,8 @@ module Types ( ) where +import Data.Foldable (fold) + newtype Document = Document { meta :: Meta } @@ -28,6 +30,7 @@ data Since = Since -- Could have a better type? type Version = [Int] + type Package = String data DocMarkup mod id @@ -51,78 +54,78 @@ data DocMarkup mod id | -- | Bold __bold text__ DocBold (DocMarkup mod id) | {- | Unordered lists - * this - or - - this + * this + or + - this -} DocUnorderedList [DocMarkup mod id] | {- | Ordered lists - 1. this - or - (1) this + 1. this + or + (1) this -} DocOrderedList [(Int, DocMarkup mod id)] | {- | Definition lists - [term] a term - [another term] another definition + [term] a term + [another term] another definition -} DocDefinitionList [(DocMarkup mod id, DocMarkup mod id)] | {- | Code blocks - @ - a code block in here - with multiple lines - @ + @ + a code block in here + with multiple lines + @ - Or with bird tracks: - > some code - > goes here + Or with bird tracks: + > some code + > goes here -} DocCodeBlock (DocMarkup mod id) | {- | Hyperlinks - __marked__: - - - __Auto-detected URLs__: - http://example.com - https://example.com - ftp://example.com - __Markdown style__ - [link text](http://example.com) - [link text]("Module.Name") + __marked__: + + + __Auto-detected URLs__: + http://example.com + https://example.com + ftp://example.com + __Markdown style__ + [link text](http://example.com) + [link text]("Module.Name") -} DocHyperlink (Hyperlink (DocMarkup mod id)) | {- | Pictures - <> - <> + <> + <> - __Markdown Images__ + __Markdown Images__ - ![alt text](image.png) + ![alt text](image.png) -} DocPicture Picture | {- | Inline math expressions - \(mathematical expression\) + \(mathematical expression\) -} DocMathInline String | {- | Math multiline display - \[ - mathematical expression - in multiple lines - \] + \[ + mathematical expression + in multiple lines + \] -} DocMathDisplay String | {- | Anchors, no spaces allowed - #anchor-name# + #anchor-name# -} DocAnchor String | {- | Property descriptions - prop> property description + prop> property description -} DocProperty String | {- | Examples - >>> expression - result line 1 - result line 2 + >>> expression + result line 1 + result line 2 -} DocExamples [Example] | -- | Header @@ -136,7 +139,7 @@ instance Semigroup (DocMarkup mod id) where instance Monoid (DocMarkup mod id) where mempty = DocEmpty - mconcat = foldr (<>) mempty + mconcat = fold data ModuleLink id = ModuleLink { name :: String diff --git a/test/Spec.hs b/test/Spec.hs index 7258a2d..7040f87 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,17 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} -import Test.Hspec - -import Identifier (Identifier) -import Lexer -import Parser -import Types - import Data.String (IsString (..)) import Data.Text (Text) import GHC.Stack +import Identifier (Identifier) +import Lexer +import Parser +import Test.Hspec import Text.Parsec.Pos +import Types main :: IO () main = hspec $ do @@ -34,9 +32,9 @@ main = hspec $ do describe "Parser" do it "Bold" do - "__bold__" `shouldParseTo` (DocBold (DocString "bold")) + "__bold__" `shouldParseTo` DocBold (DocString "bold") it "Emphasis" do - "/emphasis/" `shouldParseTo` (DocEmphasis (DocString "emphasis")) + "/emphasis/" `shouldParseTo` DocEmphasis (DocString "emphasis") ------------ -- Tests @@ -57,6 +55,7 @@ modules = do `shouldLexTo` [ (1, 2, Module "OtherModule.Name") , (1, 18, Anchor "myAnchor") ] + link :: Expectation link = "[link to](http://some.website)"