Learning-Haskell/ParserH.hs at main · Luis-omega/Learning-Haskell · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
module ParserH (parseLiterated) where

import Data.Text (Text, pack, unpack)
import qualified Data.Text as T

import Control.Applicative hiding (many, some)
import Control.Monad (void)
import Data.Void
import System.IO
import Text.Megaparsec
import Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L


type Parser = Parsec Void Text


plainSpace :: Parser Char
plainSpace = char ' '


indent :: Parser ()
indent = do
  char ' '
  char ' '
  return ()


nonLineBreak :: Parser Text
nonLineBreak = takeWhileP (Just "non line break") (/= '\n')


lineBreak :: Parser Char
lineBreak = char '\n'


slash = char '\\'


lbrace :: Parser Char
lbrace = char '{'


rbrace :: Parser Char
rbrace = char '}'


code :: Parser Text
code = string (pack "code")


begin :: Parser Text
begin = string (pack "begin")


end :: Parser Text
end = string (pack "end")


codeLine = do
  indent
  x <- nonLineBreak
  lineBreak
  return x


codeBegins :: Parser [a]
codeBegins = do
  slash
  begin
  lbrace
  many plainSpace
  code
  many plainSpace
  rbrace
  return []


codeEnds :: Parser [a]
codeEnds = do
  slash
  end
  lbrace
  many plainSpace
  code
  many plainSpace
  rbrace
  return []


innerCode :: Parser Text
innerCode = do
  codeBegins
  lineBreak
  x <- many codeLine
  codeEnds
  lineBreak
  return $ T.snoc (T.intercalate (pack "\n") x) '\n'


nonSlash :: Parser Text
nonSlash = takeWhile1P (Just "non \\") (/= '\\')


parseAll :: Parser Text
parseAll = nonSlash <|> try innerCode <|> (do slash; return $ pack "\\")


parseLiterated :: String -> String
parseLiterated s =
  case runParser (many parseAll) "hi" (pack s) of
    Right x -> unpack $ T.concat x
    Left x -> show x


parseFile = do
  input <- readFile "posts/2021-09-04-some.lhs"
  putStrLn $ parseLiterated input