MathQuery.hs

module MathQuery where

import PGF hiding (Tree)
import qualified PGF
----------------------------------------------------
-- automatic translation from GF to Haskell
----------------------------------------------------

class Gf a where
  gf :: a -> PGF.Tree
  fg :: PGF.Tree -> a

newtype GString = GString String  deriving Show

instance Gf GString where
  gf (GString x) = mkStr x
  fg t =
    case unStr t of
      Just x  ->  GString x
      Nothing -> error ("no GString " ++ show t)

newtype GInt = GInt Int  deriving Show

instance Gf GInt where
  gf (GInt x) = mkInt x
  fg t =
    case unInt t of
      Just x  ->  GInt x
      Nothing -> error ("no GInt " ++ show t)

newtype GFloat = GFloat Double  deriving Show

instance Gf GFloat where
  gf (GFloat x) = mkDouble x
  fg t =
    case unDouble t of
      Just x  ->  GFloat x
      Nothing -> error ("no GFloat " ++ show t)

----------------------------------------------------
-- below this line machine-generated
----------------------------------------------------

data GKind =
   GKNumber 
 | GKProperty GProperty GKind 
  deriving Show

data GProperty =
   GPAnd GProperty GProperty 
 | GPDivisible GTerm 
 | GPEven 
 | GPGreater GTerm 
 | GPNot GProperty 
 | GPOdd 
 | GPOr GProperty GProperty 
 | GPPrime 
 | GPSmaller GTerm 
  deriving Show

data GQuery =
   GQHowMany GKind GProperty 
 | GQWhether GTerm GProperty 
 | GQWhich GKind GProperty 
  deriving Show

data GTerm =
   GTAll GKind 
 | GTAny GKind 
 | GTInteger GInt 
  deriving Show


instance Gf GKind where
  gf GKNumber = mkApp (mkCId "KNumber") []
  gf (GKProperty x1 x2) = mkApp (mkCId "KProperty") [gf x1, gf x2]

  fg t =
    case unApp t of
      Just (i,[]) | i == mkCId "KNumber" -> GKNumber 
      Just (i,[x1,x2]) | i == mkCId "KProperty" -> GKProperty (fg x1) (fg x2)


      _ -> error ("no Kind " ++ show t)

instance Gf GProperty where
  gf (GPAnd x1 x2) = mkApp (mkCId "PAnd") [gf x1, gf x2]
  gf (GPDivisible x1) = mkApp (mkCId "PDivisible") [gf x1]
  gf GPEven = mkApp (mkCId "PEven") []
  gf (GPGreater x1) = mkApp (mkCId "PGreater") [gf x1]
  gf (GPNot x1) = mkApp (mkCId "PNot") [gf x1]
  gf GPOdd = mkApp (mkCId "POdd") []
  gf (GPOr x1 x2) = mkApp (mkCId "POr") [gf x1, gf x2]
  gf GPPrime = mkApp (mkCId "PPrime") []
  gf (GPSmaller x1) = mkApp (mkCId "PSmaller") [gf x1]

  fg t =
    case unApp t of
      Just (i,[x1,x2]) | i == mkCId "PAnd" -> GPAnd (fg x1) (fg x2)
      Just (i,[x1]) | i == mkCId "PDivisible" -> GPDivisible (fg x1)
      Just (i,[]) | i == mkCId "PEven" -> GPEven 
      Just (i,[x1]) | i == mkCId "PGreater" -> GPGreater (fg x1)
      Just (i,[x1]) | i == mkCId "PNot" -> GPNot (fg x1)
      Just (i,[]) | i == mkCId "POdd" -> GPOdd 
      Just (i,[x1,x2]) | i == mkCId "POr" -> GPOr (fg x1) (fg x2)
      Just (i,[]) | i == mkCId "PPrime" -> GPPrime 
      Just (i,[x1]) | i == mkCId "PSmaller" -> GPSmaller (fg x1)


      _ -> error ("no Property " ++ show t)

instance Gf GQuery where
  gf (GQHowMany x1 x2) = mkApp (mkCId "QHowMany") [gf x1, gf x2]
  gf (GQWhether x1 x2) = mkApp (mkCId "QWhether") [gf x1, gf x2]
  gf (GQWhich x1 x2) = mkApp (mkCId "QWhich") [gf x1, gf x2]

  fg t =
    case unApp t of
      Just (i,[x1,x2]) | i == mkCId "QHowMany" -> GQHowMany (fg x1) (fg x2)
      Just (i,[x1,x2]) | i == mkCId "QWhether" -> GQWhether (fg x1) (fg x2)
      Just (i,[x1,x2]) | i == mkCId "QWhich" -> GQWhich (fg x1) (fg x2)


      _ -> error ("no Query " ++ show t)

instance Gf GTerm where
  gf (GTAll x1) = mkApp (mkCId "TAll") [gf x1]
  gf (GTAny x1) = mkApp (mkCId "TAny") [gf x1]
  gf (GTInteger x1) = mkApp (mkCId "TInteger") [gf x1]

  fg t =
    case unApp t of
      Just (i,[x1]) | i == mkCId "TAll" -> GTAll (fg x1)
      Just (i,[x1]) | i == mkCId "TAny" -> GTAny (fg x1)
      Just (i,[x1]) | i == mkCId "TInteger" -> GTInteger (fg x1)


      _ -> error ("no Term " ++ show t)