language-gcl-0.2: samples/ParseSample.hs

{-# LANGUAGE Haskell2010 #-}
module Main where

import Control.Applicative
import Text.Parser.Char
import Text.Parser.Combinators
import Text.Parser.Token
import qualified Data.Attoparsec.Text as AT
import qualified Data.Text as T
import System.IO

import Language.GuardedCommands

main :: IO ()
main = do
    c <- T.pack <$> getContents
    case AT.parseOnly (optional someSpace *> pGCL pVoid (pBoolExpr pVar) <* AT.endOfInput) c of
        Left e -> hPutStrLn stderr e
        Right v -> print v

data BoolExpr a
    = And (BoolExpr a) (BoolExpr a)
    | Or  (BoolExpr a) (BoolExpr a)
    | Literal Bool
    | Atom a
    deriving Show

pBoolExpr :: TokenParsing m => m atom -> m (BoolExpr atom)
pBoolExpr pAtom = p0
  where
    p0 = flOr  <$> p1 <*> many (symbol "\\/" *> p1)
    p1 = flAnd <$> p2 <*> many (symbol "/\\" *> p2)
    p2 = between (symbol "(") (symbol ")") p0
        <|> Literal True <$ symbol "true"
        <|> Literal False <$ symbol "false"
        <|> Atom <$> pAtom

    flOr  x xs = foldr1 Or  (x:xs)
    flAnd x xs = foldr1 And (x:xs)

pVar :: TokenParsing m => m String
pVar = token (some upper)

data Void

instance Show Void where
    show _ = ""

pVoid :: Alternative m => m Void
pVoid = empty