rhi/lang
1
0
Fork 0
Code Issues 2 Pull requests Releases Wiki Activity

fix for ghc 9.4

Browse source
This commit is contained in:
Rhiannon Morris 2023-12-24 01:41:12 +01:00
parent e28a2c6ce4
commit 6b50c1bc60
4 changed files with 30 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
cabal.project
View file

@ -5,4 +5,4 @@ packages:
source-repository-package source-repository-package
type: git type: git
location: https://git.rhiannon.website/rhi/svg-builder location: https://git.rhiannon.website/rhi/svg-builder
tag: 1cbcd594d3009f9fd71f253b52ac82673bf5482e tag: 39bb6a4e04ec2caccc23576b062ebfa0566bfb96

6
laantas-script/laantas-script.cabal
View file

@ -30,12 +30,12 @@ executable laantas-script
RecordWildCards, RecordWildCards,
ViewPatterns ViewPatterns
build-depends: build-depends:
base >= 4.14.0.0 && < 4.17, base >= 4.14.0.0 && < 4.20,
containers ^>= 0.6.2.1, containers ^>= 0.6.2.1,
mtl ^>= 2.2.2, mtl ^>= 2.2.2,
svg-builder ^>= 0.1.1, svg-builder ^>= 0.1.1,
optparse-applicative ^>= 0.16.0.0, optparse-applicative ^>= 0.16.0.0,
text ^>= 1.2.3.2, text ^>= 2.1,
megaparsec ^>= 9.0.1 megaparsec ^>= 9.6.1
ghc-options: ghc-options:
-Wall -threaded -rtsopts -with-rtsopts=-N -Wall -threaded -rtsopts -with-rtsopts=-N

41
langfilter/Ebnf.hs
View file

@ -10,21 +10,23 @@ import Text.Pandoc.Definition
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.Void import Data.Void
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
data Rule = data Rule =
Rule Text Def Rule Text Def
| RCom Text -- ^ @(* comment *)@ | RCom Text -- ^ @(* comment *)@
deriving (Eq, Show) deriving (Eq, Show)
data Def = data Def =
N Text -- ^ @nonterminal@ N Text -- ^ @nonterminal@
| T Text -- ^ @\'terminal\'@ or @\"terminal\"@ | T Text -- ^ @\'terminal\'@ or @\"terminal\"@
| S Text -- ^ @?special?@ | S Text -- ^ @?special?@
| Or [Def] -- ^ choice @a | b | c@ | Or (NonEmpty Def) -- ^ choice @a | b | c@
| Seq [Def] -- ^ sequence @a, b, c@ | Seq (NonEmpty Def) -- ^ sequence @a, b, c@
| Sub Def Def -- ^ difference @a - b@ | Sub Def Def -- ^ difference @a - b@
| Opt Def -- ^ opt @[a]@ | Opt Def -- ^ opt @[a]@
| Many Def -- ^ repetition @{a}@ | Many Def -- ^ repetition @{a}@
| Com Text -- ^ comment | Com Text -- ^ comment
deriving (Eq, Show) deriving (Eq, Show)
@ -51,9 +53,9 @@ render1 (RCom txt) =
render1 (Rule name def) = render1 (Rule name def) =
row' [span "ebnf-nt" name] "=" d : map (row' [] "|") ds row' [span "ebnf-nt" name] "=" d : map (row' [] "|") ds
where where
d:ds = splitOrs def d :| ds = splitOrs def
splitOrs (Or ds) = ds splitOrs (Or ds) = ds
splitOrs d = [d] splitOrs d = NonEmpty.singleton d
row' c1 p d = Row mempty [cell c1, cell [punc p], cell (renderDef d)] row' c1 p d = Row mempty [cell c1, cell [punc p], cell (renderDef d)]
cell is = Cell mempty AlignDefault (RowSpan 1) (ColSpan 1) [Plain is] cell is = Cell mempty AlignDefault (RowSpan 1) (ColSpan 1) [Plain is]
@ -76,9 +78,9 @@ renderDefAt p = \case
T txt -> [span "ebnf-t" txt] T txt -> [span "ebnf-t" txt]
S txt -> [span "ebnf-s" txt] S txt -> [span "ebnf-s" txt]
Or ds -> renderParens (p > OR) $ Or ds -> renderParens (p > OR) $
intercalate [Space, punc "|", Space] $ renderDefAt OR <$> ds intercalate [Space, punc "|", Space] $ renderDefAt OR <$> NonEmpty.toList ds
Seq ds -> renderParens (p > SEQ) $ Seq ds -> renderParens (p > SEQ) $
intercalate [punc ",", Space] $ renderDefAt SEQ <$> ds intercalate [punc ",", Space] $ renderDefAt SEQ <$> NonEmpty.toList ds
Sub d e -> renderParens (p >= SUB) $ Sub d e -> renderParens (p >= SUB) $
renderDefAt SUB d <> renderDefAt SUB d <>
[Space, span "ebnf-sub" "−", Space] <> [Space, span "ebnf-sub" "−", Space] <>
@ -111,10 +113,13 @@ def :: P Def
def = ors def = ors
ors :: P Def ors :: P Def
ors = list Or <$> seqs `sepBy1` (sym "|") ors = list1 Or <$> seqs `sepBy1'` (sym "|")
seqs :: P Def seqs :: P Def
seqs = list Seq <$> sub `sepBy1` (sym ",") seqs = list1 Seq <$> sub `sepBy1'` (sym ",")
sepBy1' :: P a -> P z -> P (NonEmpty a)
sepBy1' a b = NonEmpty.fromList <$> sepBy1 a b
sub :: P Def sub :: P Def
sub = do sub = do
@ -154,9 +159,9 @@ comment = do try (string_ "(*"); go ["(*"] 1 where
bracketed :: (Def -> a) -> Char -> Char -> P a bracketed :: (Def -> a) -> Char -> Char -> P a
bracketed f o c = f <$> between (char' o) (char' c) def bracketed f o c = f <$> between (char' o) (char' c) def
list :: ([a] -> a) -> [a] -> a list1 :: (NonEmpty a -> a) -> NonEmpty a -> a
list _ [x] = x list1 _ (x :| []) = x
list f xs = f xs list1 f xs = f xs
sym :: Text -> P Text sym :: Text -> P Text

6
langfilter/langfilter.cabal
View file

@ -33,11 +33,11 @@ executable langfilter
RecordWildCards, RecordWildCards,
ViewPatterns ViewPatterns
build-depends: build-depends:
base >= 4.14.0.0 && < 4.17, base >= 4.14.0.0 && < 4.20,
containers ^>= 0.6.2.1, containers ^>= 0.6.2.1,
filepath ^>= 1.4.2.1, filepath ^>= 1.4.2.1,
megaparsec ^>= 9.0.1, megaparsec ^>= 9.6.1,
process ^>= 1.6.11.0, process ^>= 1.6.11.0,
pandoc-types ^>= 1.23, pandoc-types ^>= 1.23,
text, text ^>= 2.1,
pretty-show ^>= 1.10 pretty-show ^>= 1.10