Answer.hs

{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, FlexibleContexts #-}
import Network.FastCGI(CGI,CGIResult,runFastCGIorCGI,output,getInput,handleErrors)
--import Network.CGI(CGI,CGIResult,runCGI,output,getInput,handleErrors)
import PGF(PGF,Language,readPGF,parse,readLanguage,startCat)
import Codec.Binary.UTF8.String(decodeString)
import MathQuery

main :: IO ()
main = runFastCGIorCGI . handleErrors . cgiMain =<< readPGF "MathQuery.pgf"
--main = runCGI . handleErrors . cgiMain =&lt;&lt; readPGF "MathQuery.pgf"

cgiMain :: PGF -> CGI CGIResult
cgiMain pgf =
  do Just from <- fmap (readLanguage =<<) (getInput "from")
     Just query <- fmap (fmap decodeString) (getInput "query")
     output . maybe "NO PARSE" answer $ parseQuery pgf from query

parseQuery :: PGF -> PGF.Language -> String -> Maybe GQuery
parseQuery pgf from s =
  case parse pgf from (startCat pgf) s of
     tree:_ ->  Just (fg tree)
     _ -> Nothing

answer :: GQuery -> String
answer = comp

class Compile src dst | src->dst where comp :: src->dst

type Pred = Int->Bool
type Set  = [Int]
type Answer = String

instance Compile GQuery Answer where
  comp query =
      case query of
        GQWhether term prop -> show (comp term (comp prop))
        GQWhich   kind prop -> show (which kind prop)
        GQHowMany kind prop -> show (length (which kind prop))
    where
      which kind prop = filter (comp prop) (comp kind)

instance Compile GProperty Pred where
  comp prop =
    case prop of
      GPAnd prop1 prop2 -> lift2 (&&) (comp prop1) (comp prop2)
      GPOr prop1 prop2  -> lift2 (||) (comp prop1) (comp prop2)
      GPNot prop        -> not . comp prop
      GPGreater term    -> comp term . (>)
      GPSmaller term    -> comp term . (<)
      GPDivisible term  -> comp term . divisible
      GPEven            -> even
      GPOdd             -> odd
      GPPrime           -> prime

lift2 op f g = \ x -> f x `op` g x

instance Compile GKind Set where
  comp GKNumber = [1..1000]
  comp (GKProperty prop kind) = filter (comp prop) (comp kind)

instance Compile GTerm (Pred->Bool) where
  comp term =
    case term of
      GTAll kind         -> \ p -> all p (comp kind)
      GTAny kind         -> \ p -> any p (comp kind)
      GTInteger (GInt n) -> \ p -> p n


divisible x y = x `mod` y == 0
prime n = n>1 && and [not (divisible n d) | d <-[2..n `div` 2]]
          -- could be more efficient...