summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
authoraarne <aarne@chalmers.se>2014-12-05 17:01:58 +0000
committeraarne <aarne@chalmers.se>2014-12-05 17:01:58 +0000
commit52d38392715cf05fc626d7ff1454c2acf0d8b20c (patch)
tree90848e618e78a03e3df98bae2c5dd516e22507f9 /examples
parentfc46db8c7f98dd51020ef765c98e12d1e450b5e6 (diff)
a script for analysing missing functions, e.g. "which functions of type Quant are missing in each language"
Diffstat (limited to 'examples')
-rw-r--r--examples/app/MissApp.hs50
1 files changed, 50 insertions, 0 deletions
diff --git a/examples/app/MissApp.hs b/examples/app/MissApp.hs
new file mode 100644
index 000000000..2341f06f9
--- /dev/null
+++ b/examples/app/MissApp.hs
@@ -0,0 +1,50 @@
+module MissApp where
+
+import qualified Data.Set as S
+import qualified Data.Map as M
+import Data.Char
+
+-- prerequisite: pg -missing | wf -file=missing-app.txt
+
+missFile = "missing-app.txt"
+
+allLangs = words "AppBul AppCat AppChi AppDut AppEng AppFin AppFre AppGer AppHin AppIta AppSpa AppSwe"
+
+type Lang = String
+type Fun = String
+
+type MissMap = M.Map Lang (S.Set Fun)
+
+getMissMap :: FilePath -> IO MissMap
+getMissMap file = do
+ ms <- readFile file >>= return . map words . lines
+ return $ M.fromList [(lang,S.fromList ws) | lang:":":ws <- ms]
+
+ifMiss :: MissMap -> Lang -> Fun -> Bool
+ifMiss mm lang fun = case M.lookup lang mm of
+ Just ws -> S.member fun ws
+ _ -> error $ "language not found: " ++ lang
+
+allMissLangs :: MissMap -> Fun -> [Lang]
+allMissLangs mm fun = [l | l <- allLangs, ifMiss mm l fun]
+
+allMissFuns :: MissMap -> Lang -> [Fun]
+allMissFuns mm lang = maybe [] S.toList $ M.lookup lang mm
+
+isSyntaxFun :: Fun -> Bool
+isSyntaxFun (f:un) = isUpper f && any isUpper un -- the latter to exclude Phrasebook
+
+allMissingSyntaxFuns :: MissMap -> [(Lang,[Fun])]
+allMissingSyntaxFuns mm = [(l,takeWhile isSyntaxFun $ allMissFuns mm l) | l <- allLangs] -- takeWhile works on the sorted list
+
+allMissingSuchFuns :: MissMap -> (Fun -> Bool) -> [(Lang,[Fun])]
+allMissingSuchFuns mm f = [(l,filter f $ allMissFuns mm l) | l <- allLangs]
+
+allMissingThoseFuns :: MissMap -> [Fun] -> [(Lang,[Fun])]
+allMissingThoseFuns mm fs = let s = S.fromList fs in allMissingSuchFuns mm (flip S.member s)
+
+parts :: Fun -> [String]
+parts f = words (map (\c -> if c =='_' then ' ' else c) f)
+
+catOf :: Fun -> String
+catOf = last . parts