tricu

An interpreted language for exploring Tree Calculus
Log | Files | Refs | README | LICENSE

consumer_comments.tri (2724B)

      1 -- Shared SCP lexer: line comments must not change authored IR or locations.
      2 !import "consumers.base-source" B
      3 !import "consumers.registry-source" R
      4 !import "parser" P
      5 !import "lexer" L
      6 !import "prelude" !Local
      7 
      8 basePlain = "consumer quoted\n  [] @ _ => \"-- literal\"\n  [x | xs] @ _ => x"
      9 baseCommented = "-- header\nconsumer quoted -- declaration\n  -- first rule\n  [] @ _ => \"-- literal\" -- literal is not a comment\n\n  [x | xs] @ _ => x -- final rule\n-- at EOF"
     10 baseLocated = B.compileBaseSourceLocated baseCommented
     11 baseCrlf = B.compileBaseSourceLocated "-- header\r\nconsumer crlf -- next\r\n  [] @ _ => []"
     12 crlfRows = snd (resultOr t baseCrlf)
     13 crlfFirst = fst (fst crlfRows)
     14 baseRows = snd (resultOr t baseLocated)
     15 baseFirst = fst (fst baseRows)
     16 baseFirstOutput = snd (fst baseRows)
     17 baseSecond = fst (fst (snd baseRows))
     18 baseBad = B.compileBaseSource "-- first\nconsumer broken\n  -- rule\n  [] @ _ => $"
     19 failure result = matchResult (diagnostic _ : diagnostic) (_ _ : t) result
     20 badLocation = P.parserDiagnosticLocation (failure baseBad)
     21 fizzPlain = "consumer fizzbuzz [] @ (2,4) => []"
     22 fizzCommented = "-- intro\nconsumer fizzbuzz -- header\n  [] @ (2,4) => [] -- output\n-- end"
     23 routePlain = "consumer route GET \"/--\" @ _ => reply 200 \"text/plain\" \"-- okay\""
     24 routeCommented = "-- route\nconsumer route -- title\n  GET \"/--\" @ _ => reply 200 \"text/plain\" \"-- okay\" -- output\n-- end"
     25 cases = [
     26   (resultIsOk baseLocated)
     27   (equal? (resultOr t (B.compileBaseSource basePlain))
     28     (fst (resultOr t baseLocated)))
     29   (equal? (L.lexerPositionLine baseFirst) 4)
     30   (equal? (L.lexerPositionColumn baseFirst) 3)
     31   (equal? (L.lexerPositionOffset baseFirst)
     32     (length "-- header\nconsumer quoted -- declaration\n  -- first rule\n  "))
     33   (resultIsOk baseCrlf)
     34   (equal? (L.lexerPositionLine crlfFirst) 3)
     35   (equal? (L.lexerPositionColumn crlfFirst) 3)
     36   (equal? (L.lexerPositionLine baseFirstOutput) 4)
     37   (equal? (L.lexerPositionColumn baseFirstOutput) 13)
     38   (equal? (L.lexerPositionLine baseSecond) 6)
     39   (equal? (L.lexerPositionColumn baseSecond) 3)
     40   (equal? (P.parserDiagnosticCode (failure baseBad)) 4)
     41   (equal? (L.lexerPositionLine badLocation) 4)
     42   (equal? (L.lexerPositionColumn badLocation) 13)
     43   (equal? (B.compileBaseSource fizzPlain)
     44     (B.compileBaseSource fizzCommented))
     45   (resultIsOk (B.compileBaseSource fizzCommented))
     46   (equal? (R.compileRouteSource routePlain)
     47     (R.compileRouteSource routeCommented))
     48   (resultIsOk (R.compileRouteSource routeCommented))
     49   (equal? (P.parserDiagnosticCode (failure
     50     (B.compileBaseSource "consumer broken -- comment\n  [] @ _ => -"))) 4)]
     51 checks = foldl and? true cases
     52 main = matchBool "consumer-comments-ok" "consumer-comments-DIFFER" checks
     53 main