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
|
{-
This parser example has adjustable maximum depth levels for
parenthesized expressions and for raw text runs. Once those levels are
reached, it ceases to store children of parenthesized expressions and
stores their raw contents instead, and concatenates the tokens of raw
text runs.
-}
{-# LANGUAGE OverloadedStrings #-}
import Data.Attoparsec.ByteString.Char8
import Data.Tree
import qualified Data.ByteString.Char8 as BS
import Control.Applicative (many, some, (<|>))
import System.Environment
import Numeric
pTree :: (Int, Int, Int) -> Parser (Tree BS.ByteString)
pTree (level, maxDepthP, maxDepthW) =
((\(r, c) -> if level < maxDepthP then Node BS.empty c else Node r [])
<$> (match (char '(' *>
pForest (level + 1, maxDepthP, maxDepthW)
<* char ')')))
<|> flip Node [] . BS.pack <$>
(if level < maxDepthW then id else (\p -> concat <$> some p))
(choice
[ some (satisfy (inClass " \n"))
, some (satisfy (notInClass " \n()\\")
<|> (char '\\' *> satisfy (inClass " \n()\\")))])
pForest :: (Int, Int, Int) -> Parser (Forest BS.ByteString)
pForest = many . pTree
escape :: BS.ByteString -> BS.ByteString
escape s
| BS.all (inClass " \n") s = s
| otherwise = BS.concatMap
(\c -> BS.pack $ if inClass " \n()\\" c then ['\\', c] else [c]) s
unescape' :: [Char] -> [Char]
unescape' [] = []
unescape' ('\\':c:rest) = c : unescape' rest
unescape' (c:rest) = c : unescape' rest
unescape :: BS.ByteString -> BS.ByteString
unescape = BS.pack . unescape' . BS.unpack
showTree :: Tree BS.ByteString -> BS.ByteString
showTree (Node val [])
| BS.null val = "()"
| otherwise = escape val
showTree (Node _ children) =
BS.concat ["(", showForest children, ")"]
showForest :: Forest BS.ByteString -> BS.ByteString
showForest = BS.concat . map showTree
main :: IO ()
main = do
as <- getArgs
let (maxDepthP, maxDepthW) = case as of
[p', w'] -> case (readDec p', readDec w') of
([(p, "")], [(w, "")]) -> (p, w)
_ -> (100, 100)
_ -> (100, 100)
v <- parseOnly (pForest (0, maxDepthP, maxDepthW) <* endOfInput)
<$> BS.getContents
case v of
Right v' -> do
print v'
BS.putStrLn $ showForest v'
Left e -> putStrLn $ "Parse error: " ++ e
|
