Здравствуйте, VladD2, Вы писали:
VD>Откровенно говоря я не знаю что такое json. Но наверно пойдет.
Так! Парсер написал. Думал дольше времени уйдёт, наверное, рука набита
Если у тебя есть установленный Haskell, то это сообщение можешь просто скопировать в файл, обозвать его, дав ему расширение lhs, и запустить. В этом файле весь код идёт после '>'.
Он ожидает один аргумент с командной строки -- имя файла, который будет парситься. Твою задачу -- подсчитать кол-во токенов -- я немного изменил, чтобы можно было показать как парситься структура (а то можно было просто накапливать счётчик да и всё).
Сейчас задание такое -- подсчитать кол-во значений в иерархии.
Вроде всё, остальные замечания дальше.
Итак, нам потребуются кое какие библиотеки, например, сам Parsec.
> import Control.Monad (liftM)
> import Data.Char (isControl)
> import System.Environment (getArgs)
> import Text.ParserCombinators.Parsec
> import Text.ParserCombinators.Parsec.Language (emptyDef)
> import qualified Text.ParserCombinators.Parsec.Token as P
Парсить мы будем JSON-овскую структуру, которая состоит из неких значений. Значения могут быть объектом (набор пар — имя/значение), массивом (набор значений), строкой, числом, логическим значением или null.
Всё это выражено в следующем АТД.
> data JsonValue = JObject [(String, JsonValue)]
> | JArray [JsonValue]
> | JString String
> | JNumber Double
> | JBool Bool
> | JNull
Программа, как уже говорилось, берёт единственный аргумент из командной строки -- имя файла -- и парсит его.
Никакой обработки ошибок по кол-ву аргументов я не писал.
> main = do
> [fname] <- getArgs
> parseJson fname
Шаблонная для таких целей функция. Читаем файл, парсим его (parseFromFile), если были ошибки -- выводим их, нет -- обрабатываем (handle) распаршенное.
> parseJson :: SourceName -> IO ()
> parseJson fname =
> do parsed <- parseFromFile jsonSource fname
> case parsed of
> Left err -> print err
> Right v -> print (handle v)
Обработка в нашем случае -- это подсчёт всех переданных значений.
> handle = countJsonValue
Собственно сам подсчёт. Ничего сложного. Все значения (даже null) имеют цену 1, массив и объект ещё добавляют к ней колво потрохов.
> countJsonValue (JObject xs) = 1 + sum (map (countJsonValue . snd) xs)
> countJsonValue (JArray xs) = 1 + sum (map countJsonValue xs)
> countJsonValue _ = 1
Та-а-а-ак. Теперь начинается интересное. Для лексера в Parsec есть удобная штука, которая называется TokenParser.
Это просто набор полезных комбинаторов. Для каждого языка он разумеется свой, но ничто не мешает нам воспользоваться чужим.
Комбинаторов этих много, некоторые, которые нам пригодятся, я описал их ниже.
Сначала создадим сам лексер, задав ключевые слова (в принципе нужды в них нет, ну да пусть будут).
Если в json есть комментарии, то их тоже можно было бы здесь задать. И ещё несколько параметров.
> lexer :: P.TokenParser ()
> lexer = P.makeTokenParser $ emptyDef
> {
> P.reservedNames = ["true", "false", "null"]
> }
А вот и сами комбинаторы. Названия в принципе говорят сами за себя.
stringLiteral я здесь закомментировал, а ниже написал свой, т.к. родной не подходит (увы) для парсинга строк именно JSON-а.
Заодно, возможно, будет интересно поглядеть, как пишут лексер. Названия комбинаторов погляди — это инструменты, с которыми мы будем работать.
> lexeme = P.lexeme lexer
> --stringLiteral = P.stringLiteral lexer
> symbol = P.symbol lexer
> float = P.float lexer
> reserved = P.reserved lexer
> brackets = P.brackets lexer
> braces = P.braces lexer
> commaSep = P.commaSep lexer
Итак, это было стандартное вступление, не особо интересное. Сейчас будем писать собственно парсер.
Смотреть, начиная отсюда

Комментировать буду уж совсем непонятное.
> jsonSource = object <|> array
Объект это что то вроде:
object ::= '{' members '}' , вернуть JObject members
'{' members '}' -- это braces members
а liftM JObject возвращает нужное нам значение объекта.
> object = liftM JObject $ braces members
члены -- это разделённые запятыми пары.
> members = commaSep pair
pair, думаю, понятно — читаем строку, пропускаем ':', читаем значение, возвращаем пару.
> pair = do name <- stringLiteral
> symbol ":"
> val <- value
> return (name, val)
array аналогично object.
> array = liftM JArray $ brackets elements
elements аналогично members
> elements = commaSep value
value просто перечисляет возможные JSON-значения.
Функция choice разворачивает свои аргументы, разделяя их <|>. Тупой options, в общем.
> value = choice [object, array, jstring, jnumber, jtrue, jfalse, jnull]
jstring, jnumber -- возвращают соответствующее распаршенному значение.
Т.е. float распарсит нам d :: Double, а jnumber вернёт (JNumber d).
> jstring = liftM JString stringLiteral
> jnumber = liftM JNumber float
Для keyword-ов написал отдельную функцию, в принципе это делать было необязательно. Так для удобства.
> keyword kw ctr = reserved kw >> return ctr
> jtrue = keyword "true" (JBool True)
> jfalse = keyword "false" (JBool False)
> jnull = keyword "null" JNull
А теперь более низкий уровень. Как разбирается строка.
Сам stringLiteral — это просто лексема, у которой между кавычками куча символов:
> stringLiteral = lexeme $ between quote quote (many stringChar)
> where
> quote = char '"'
Символ -- это либо заэскейпленный символ, либо обычная буква.
> stringChar = stringEscape <|> stringLetter
Заэскейпленный символ -- читаем '\', дальше меняем букву на соответствующий символ.
См. два списка в функции. Кстати, на разбор строки на konsoletyper-овском парсере было бы интересно посмотреть.
> stringEscape = do
> char '\\'
> choice $ zipWith escaped ['\\', '/', '"', 'b', 'f', 'n', 'r', 't']
> ['\\', '/', '"', '\b', '\f', '\n', '\r', '\t']
> where
> escaped chr sym = char chr >> return sym
Буква — это не кавычка, на слеш, не управляющий символ. Юникод пропустил -- лень писать, там ещё одна-две строчки.
> stringLetter = satisfy (\c -> c /= '"' && c /= '\\' && not (isControl c))
Отличие, которое заметно сразу -- это то, что у меня структуру (АТД) Parsec не генерит в отличие от.
Насчёт first-class правил в парсере konsoletyper-а было бы интересно узнать. Они позволяют делать то, что в bnf нельзя.
... << RSDN@Home 1.1.4 stable SR1 rev. 568>>