{-# 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 ++ "%"