summaryrefslogtreecommitdiff
path: root/src/server/MainFastCGI.hs
diff options
context:
space:
mode:
authorbjorn <bjorn@bringert.net>2008-08-14 09:06:26 +0000
committerbjorn <bjorn@bringert.net>2008-08-14 09:06:26 +0000
commita7aa8fb9812a204f0a1a984cb1d4c727761490ff (patch)
tree4fc793d703114d2ce84920b28ae2430cc6ed341b /src/server/MainFastCGI.hs
parent77270a010a0b453e9a84c3e62db7cfd22e49d55d (diff)
Added first version of the GF FastCGI server.
Diffstat (limited to 'src/server/MainFastCGI.hs')
-rw-r--r--src/server/MainFastCGI.hs53
1 files changed, 53 insertions, 0 deletions
diff --git a/src/server/MainFastCGI.hs b/src/server/MainFastCGI.hs
new file mode 100644
index 000000000..7c02924d6
--- /dev/null
+++ b/src/server/MainFastCGI.hs
@@ -0,0 +1,53 @@
+import PGF
+import FastCGIUtils
+
+import Network.CGI hiding (Language)
+import Text.JSON
+import qualified Codec.Binary.UTF8.String as UTF8 (encodeString)
+
+import Data.Maybe
+
+
+grammarFile :: FilePath
+grammarFile = "grammar.pgf"
+
+
+newtype Record a = Record { unRecord :: [(String,a)] }
+
+type Translation = Record [Record String]
+
+instance JSON a => JSON (Record a) where
+ readJSON = fmap (Record . fromJSObject) . readJSON
+ showJSON = showJSON . toJSObject . unRecord
+
+main :: IO ()
+main = do initFastCGI
+ r <- newDataRef
+ loopFastCGI (fcgiMain r)
+
+fcgiMain :: DataRef PGF -> CGI CGIResult
+fcgiMain ref = getData readPGF ref grammarFile >>= cgiMain
+
+cgiMain :: PGF -> CGI CGIResult
+cgiMain pgf =
+ do path <- pathInfo
+ case path of
+ "/translate" -> do input <- fmap (fromMaybe "") $ getInput "input"
+ mcat <- getInput "cat"
+ mfrom <- getInput "from"
+ mto <- getInput "to"
+ outputJSON $ translate pgf input mcat mfrom mto
+ _ -> outputNotFound path
+
+outputJSON :: JSON a => a -> CGI CGIResult
+outputJSON x = do setHeader "Content-Type" "text/json; charset=utf-8"
+ output $ UTF8.encodeString $ encode x
+
+translate :: PGF -> String -> Maybe Category -> Maybe Language -> Maybe Language -> Translation
+translate pgf input mcat mfrom mto =
+ Record [(from, [Record [(to, linearize pgf to tree) | to <- toLangs] | tree <- parse pgf from cat input])
+ | from <- fromLangs]
+ where cat = fromMaybe (startCat pgf) mcat
+ fromLangs = maybe (languages pgf) (:[]) mfrom
+ toLangs = maybe (languages pgf) (:[]) mfrom
+ \ No newline at end of file