packages feed

concrete-haskell-0.1.0.13: src/Data/Concrete/Parsers/PTB.hs

{-# LANGUAGE DeriveGeneric, OverloadedStrings, ApplicativeDo #-}
module Data.Concrete.Parsers.PTB
       ( parser
       ) where

import Data.Char (isSpace)
import Data.List (intercalate)
import Data.Concrete.Parsers.Types (Bookkeeper(..), CommunicationParser)
import Data.Concrete.Parsers.Utils (communicationRule)
import Data.Scientific (scientific, Scientific(..))
import Data.Text.Lazy (pack, Text)
import Data.Functor (($>))
import qualified Data.Map as Map
import Data.Map (Map)
import Data.List.NonEmpty (fromList)
import Text.Megaparsec.Lexer (symbol, lexeme, signed, number)
import Text.Megaparsec.Pos (initialPos, defaultTabWidth)
import Text.Megaparsec.Error (Dec)
import Text.Megaparsec.Lexer (symbol, lexeme, signed, number)
import Text.Megaparsec ( parseErrorPretty
                       , (<|>)
                       , satisfy
                       , space
                       , hexDigitChar
                       , count
                       , manyTill
                       , anyChar
                       , runParser
                       , some
                       , char
                       , choice
                       , sepBy
                       , between
                       , match
                       , ParsecT
                       , runParserT'
                       , State(..)
                       , getParserState
                       , spaceChar
                       , eof
                       , noneOf
                       , try
                       )

import Control.Monad.IO.Class (liftIO)       
import Text.Megaparsec.Text.Lazy (Parser)
import Data.Concrete.Autogen.Communication_Types (default_Communication, Communication(..))
import qualified Control.Monad.State as S
import qualified Control.Monad.Identity as I
--import Data.Concrete.Types
import Data.Concrete.Parsers.Utils (communicationRule, sectionRule)

parser :: CommunicationParser ()
parser = do
  space
  some document
  space
  eof
  return ()

-- type CS = CommunicationParser String
-- type CSS = CommunicationParser [String]
-- type CC = CommunicationParser Char

document :: CommunicationParser ()
document = lexeme' $ communicationRule id (parens (some sentence)) >> return ()

sentence = lexeme' $ between (symbol' "(S") (symbol' ")") (some phrase)

phrase = lexeme' $ parens (tag >> some (tag <|> phrase)) >> return []

tag = lexicalItem

lexicalItem = lexeme' $ some notSpaceOrParen

notSpaceOrParen = satisfy (\c -> and [(not . isSpace) c, ('(' /= c), (')' /= c)])

lexeme' = lexeme space
symbol' = symbol space
parens = between (symbol' "(") (symbol' ")")