83 lines
2.5 KiB
Haskell
83 lines
2.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DeriveFoldable #-}
|
|
{-# OPTIONS_GHC -Wno-unused-do-bind #-}
|
|
|
|
module INAST where
|
|
|
|
import Data.Attoparsec.Text (Parser, decimal, choice, option, sepBy, endOfLine, many1)
|
|
|
|
insuranceNetworkParser :: Parser InsuranceNetworkAST
|
|
insuranceNetworkParser = many1 line
|
|
where
|
|
-- <line> ::= <insurer-id> ":" <percent> <optional-exprs>
|
|
-- <optional-exprs> ::= "" | "if" <exprs>
|
|
line :: Parser INASTLine
|
|
line = do
|
|
id' <- insurerId
|
|
": "
|
|
pc <- percent
|
|
oe <- option [] (" if " *> exprs)
|
|
endOfLine
|
|
pure $ INASTLine id' pc oe
|
|
-- <exprs> ::= <expr> | <expr> "and" <exprs>
|
|
exprs :: Parser [ INASTExpr ]
|
|
exprs = expr `sepBy` " and "
|
|
-- <expr> ::= <lesser-than> | <greater-than> | <equals> | <insurer-id>
|
|
expr :: Parser INASTExpr
|
|
expr = choice [ INASTExprLt <$> lt
|
|
, INASTExprGt <$> gt
|
|
, INASTExprEq <$> eq
|
|
, INASTExprInsurerId <$> insurerId ]
|
|
-- <lesser-than> ::= "<" <integer>
|
|
lt :: Parser INASTLt
|
|
lt = INASTLt <$> ("<" *> integer)
|
|
-- <greater-than> ::= ">" <integer>
|
|
gt :: Parser INASTGt
|
|
gt = INASTGt <$> (">" *> integer)
|
|
-- <equals> ::= "=" <integer>
|
|
eq :: Parser INASTEq
|
|
eq = INASTEq <$> ("=" *> integer)
|
|
-- <insurer-id> ::= "I" <integer>
|
|
insurerId :: Parser INASTInsurerId
|
|
insurerId = INASTInsurerId <$> ("I" *> integer)
|
|
-- <percent> ::= <integer> "%"
|
|
percent :: Parser INASTPercent
|
|
percent = INASTPercent <$> integer <* "%"
|
|
-- <integer> ::= <digit> | <non-zero-digit> <integer>
|
|
-- Overapproximation of the grammar
|
|
integer :: Parser Int
|
|
integer = decimal
|
|
|
|
type InsuranceNetworkAST = [INASTLine]
|
|
|
|
data INASTLine =
|
|
INASTLine { unINASTLineInsurerId :: INASTInsurerId
|
|
, unINASTLinePercent :: INASTPercent
|
|
, unINASTLineExprs :: [INASTExpr]
|
|
}
|
|
deriving (Show)
|
|
|
|
data INASTExpr = INASTExprLt INASTLt
|
|
| INASTExprGt INASTGt
|
|
| INASTExprEq INASTEq
|
|
| INASTExprInsurerId INASTInsurerId
|
|
deriving (Show)
|
|
|
|
newtype INASTLt = INASTLt Int
|
|
deriving (Show)
|
|
newtype INASTGt = INASTGt Int
|
|
deriving (Show)
|
|
newtype INASTEq = INASTEq Int
|
|
deriving (Show)
|
|
newtype INASTInsurerId = INASTInsurerId { unNASTInsurerId :: Int }
|
|
deriving (Eq)
|
|
|
|
instance Show INASTInsurerId where
|
|
show (INASTInsurerId i) = "I" ++ show i
|
|
|
|
newtype INASTPercent = INASTPercent { unINASTPercent :: Int }
|
|
|
|
instance Show INASTPercent where
|
|
show (INASTPercent p) = show p ++ "%"
|
|
|