Parser.hs

-----------------------------------------------------------------------------
-- Copyright 2020, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
module Domain.Statistics.Parser (parseComponentSet) where

import Domain.Math.Expr
import Domain.Statistics.ComponentSet
import Ideas.Utils.Parsing hiding (char)
import qualified Ideas.Utils.Parsing as P

parseComponentSet :: String -> Either String ComponentSet
parseComponentSet = parseSimple pComponentSet 

pComponentSet :: Parser ComponentSet
pComponentSet = mconcat <$> many pComponent

pComponent :: Parser ComponentSet
pComponent = do
   (k, b) <- pKey
   char ':'
   v <- pValue
   char ';'
   return $ if b then initialSet [(k, v)] else derivedSet [(k, v)]

pKey :: Parser (ComponentId, Bool)
pKey = (\n -> (n, True))  <$> brackets pComponentId 
   <|> (\n -> (n, False)) <$> pComponentId

pComponentId :: Parser ComponentId
pComponentId = fromCId <$> parseName

pValue :: Parser Component
pValue = CChoice <$> try parseChoice
    <|> CRelation <$> try pRelExpr
    <|> CExpr <$> try pExpr
    
brackets :: Parser a -> Parser a
brackets p = do
   char '['
   a <- p
   char ']'
   return a

parseChoice :: Parser Choice
parseChoice = choice [ x <$ try (string (show x)) | x <- choices ]

parseName :: Parser String
parseName =
  let
   firstChar    = oneOf $ ['a'..'z'] ++ ['A'..'Z']
   nonFirstChar = oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "-"
  in do
    fc <- firstChar
    rest <- many nonFirstChar
    return (fc:rest)

----------------------------------------------------------------------------

char :: Char -> Parser ()
char c = lexeme (P.char c) >> return ()

whitespace :: Parser ()
whitespace = many (oneOf " \n\t") >> return ()

lexeme :: Parser a -> Parser a
lexeme p = do
   x <- p
   whitespace
   return x