summaryrefslogtreecommitdiff
path: root/examples/tutorial/embedded/TransferLoop.hs
blob: 5663a1eb5975aefea6c10f6d66c4f555176908cd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
module Main where

import GF.Embed.EmbedAPI
import GSyntax

main :: IO () 
main = do
  gr <- file2grammar "math.gfcm"
  loop (translate answerTree gr)

loop :: (String -> String) -> IO ()
loop trans = do 
  s <- getLine
  if s == "quit" then putStrLn "bye" else do  
    putStrLn $ trans s
    loop trans

translate :: (Tree -> Tree) -> MultiGrammar -> String -> String
translate tr gr = unlines . map transLine . lines where
  transLine s = case parseAllLang gr (startCat gr) s of
    (lg,t:_):_ -> linearize gr lg (tr t)
    _ -> "NO PARSE"

answerTree :: Tree -> Tree
answerTree = gf . answer . fg

answer :: GQuestion -> GAnswer
answer p = case p of
  GOdd x   -> test odd x
  GEven x  -> test even x
  GPrime x -> test prime x

value :: GObject -> Int
value e = case e of
  GNumber (GInt i) -> fromInteger i

test :: (Int -> Bool) -> GObject -> GAnswer
test f x = if f (value x) then GYes else GNo

prime :: Int -> Bool
prime = (< 8) ----