paripari-0.5.0.0: example.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}

import Data.Foldable (for_)
import System.Environment (getArgs)
import Text.PariPari
import qualified Data.ByteString as B

type StringType    = B.ByteString
type ParserMonad p = CharParser StringType p
type Parser a      = (forall p. ParserMonad p => p a)

-- {-# SPECIALISE_ALL ParserMonad p = p ~ Acceptor StringType #-}
-- {-# SPECIALISE_ALL ParserMonad p = p ~ Reporter StringType #-}
-- {-# SPECIALISE_ALL Parser = Acceptor StringType #-}
-- {-# SPECIALISE_ALL Parser = Reporter StringType #-}

data Value
  = Object ![(StringType, Value)]
  | Array  ![Value]
  | String !StringType
  | Number !Integer !Integer
  | Bool   !Bool
  | Null
  deriving (Eq, Show)

json :: Parser Value
json = space *> (object <|> array) <?> "json"

object :: Parser Value
object = Object <$> (char '{' *> space *> sepBy pair (space *> char ',' *> space) <* space <* char '}') <?> "object"

pair :: Parser (StringType, Value)
pair = (,) <$> (text <* space) <*> (char ':' *> space *> value)

array :: Parser Value
array = Array <$> (char '[' *> sepBy value (space *> char ',' *> space) <* space <* char ']') <?> "array"

value :: Parser Value
value =
  (String <$> text)
    <|> object
    <|> array
    <|> (Bool False <$ string "false")
    <|> (Bool True  <$ string "true")
    <|> (Null       <$ string "null")
    <|> number

text :: Parser StringType
text = char '"' *> takeCharsWhile (/= '"') <* char '"' <?> "text"

number :: Parser Value
number = label "number" $ do
  neg <- sign
  frac <- fractionDec (pure ())
  pure $ case frac of
           Left n -> Number (neg n) 0
           Right (c, _, e) -> Number (neg c) e

space :: Parser ()
space = skipCharsWhile (\c -> c == ' ' || c == '\n' || c == '\t')

main :: IO ()
main = do
  args <- getArgs
  case args of
    [file] -> do
      src <- B.readFile file
      let (result, reports) = runCharParser json file src
      for_ reports $ putStrLn . showReport
      case result of
        Just val -> print val
        Nothing  -> print $ runTracer json file src
    _ -> error "Usage: paripari-example test.json"