module PrintSw where
import List(intersperse,nub,inits)
import Util
import Dictionary
import General
import Char
import Data.Bits ((.&.))
print_table = [("multi",multi_printer),("rdf_sb",prRDF_sb),("flat_xml",prFlatXML)]
-- | Print JSON
multi_printer :: Dictionary -> String
multi_printer = concat . nub . concat . map prOne . filter is_multi. unDict
where prOne (id,stem,para,cat,inhs,tbl,_) =
[conc [p "word" x, p "head" stem, p "pos" cat, p "param" "frag", pl "inhs" inhs, p "id" id, p "p" para, p "attr" (show attr)] | (a,(attr,s)) <- (merge tbl), str <- unStr s, length (words str) > 1, x <- map unwords $ gen (words str)]
merge [] = []
merge [x] = [x]
merge (x@(param1,(a,s)):y@(param2,(a',s1)):xs) =
case (number param1, number param2) of
((v,n1,n2),(v',n1',n2')) | v == v' && n1' > n1 -> merge ((param2,(a',mkStr (unwords (unStr s ++ unStr s1)))):xs)
_ -> x:merge (y:xs)
number p = case map (map (read :: String -> Int) . words . map f) (filter (isDigit.head) (words p)) of
[[v1,n1,n2]] -> (v1,n1,n2)
f x
| elem x "-:" = ' '
| otherwise = x
gen :: [String] -> [[String]]
gen [] = []
gen (x:xs) = filter (\xs -> not (null xs || one xs)) (inits (x:xs)) ++ gen xs
one [_] = True
one _ = False
pl s [] = quote s ++ ":" ++ "[]"
pl s xs = quote s ++ ":[" ++ (concat (intersperse "," (map quote xs))) ++"]"
p s1 s2 = quote s1 ++ ":" ++ quote s2
conc xs = '{':(concat (intersperse "," xs)) ++ "}\n"
is_multi (_,stem,para,cat,_,_,_) = length (words stem) > 1
-- | Print RDF
prRDF_sb :: Dictionary -> String
prRDF_sb d = unlines [
"",
"",
(concat (map pr (unDict d))),
""]
where
pr (id,stem,para,cat,inhs,tbl,extr) =
concat
[
" \n",
" \n",
" " ++ amp stem ++ "\n",
" " ++ para ++ "\n",
" " ++ cat ++ "\n",
concat [" " ++ i ++ "\n" | i <- inhs] ++ " \n",
concat [unlines [" ",
" ",
" ",
" " ++ p ++ "",
concat (intersperse "\n" [" " ++ (amp w) ++ "" | w <- unStr ws]),
" "] | (p,(_,ws)) <- tbl, not (null (unStr ws))]
]
-- | Print RDF
prFlatXML :: Dictionary -> String
prFlatXML d = unlines [
"",
"",
"",
(concat (map pr (unDict d))),
""]
where
pr (id,stem,para,cat,inhs,tbl,extr) =
concat
[
" \n",
" " ++ id ++ "\n",
" " ++ amp stem ++ "\n",
" " ++ para ++ "
\n",
" " ++ cat ++ "\n",
" " ++ (unwords inhs) ++ "\n",
" \n",
concat (intersperse "\n" [" " | (p,(_,ws)) <- tbl, w <- unStr ws]),
"\n
\n",
" \n"
]
-- copied from Module : HTTP
-- Copyright : (c) Warrick Gray 2002
-- License : BSD
amp = concat . map (\c -> if c == '&' then "&" else [c])
urlEncode (h:t) =
let str = if reserved (ord h) then escape h else [h]
in str ++ urlEncode t
urlEncode [] = []
reserved x
| x >= ord 'a' && x <= ord 'z' = False
| x >= ord 'A' && x <= ord 'Z' = False
| x >= ord '0' && x <= ord '9' = False
| x <= 0x20 || x >= 0x7F = True
| otherwise = x `elem` map ord [';','/','?',':','@','&'
,'=','+',',','$','{','}'
,'|','\\','^','[',']','`'
,'<','>','#','%','"']
escape x =
let y = ord x
in [ '%', intToDigit ((y `div` 16) .&. 0xf), intToDigit (y .&. 0xf) ]