/usr/lib/hugs/packages/HaXml/programs/MkOneOf/Main.hs is in libhugs-haxml-bundled 98.200609.21-5.3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 | module Main where
import System (getArgs)
import Char (isDigit)
import IO (hFlush,stdout)
main = do
args <- getArgs
case length args of
1 -> do n <- saferead (head args)
putStrLn ("module Text.XML.HaXml."++constructor 1 n++" where\n")
putStrLn ("import Text.XML.HaXml.XmlContent\n")
putStrLn (mkOneOf n)
2 -> do n <- saferead (args!!0)
m <- saferead (args!!1)
putStrLn ("module Text.XML.HaXml.OneOfN where\n")
putStrLn ("import Text.XML.HaXml.XmlContent\n")
mapM_ (putStrLn . mkOneOf) [n..m]
_ -> error "Usage: MkOneOf n [m]"
hFlush stdout
---- main text-generating function ----
mkOneOf :: Int -> String
mkOneOf n =
"data "++ typename n 12
++ "\n "++ format 3 78 3 " = " " | "
(zipWith (\m v->constructor m n++" "++v)
[1..n]
(take n variables))
++ "\n deriving (Eq,Show)"
++ "\n\ninstance "++ format 10 78 10 "(" ","
(map ("HTypeable "++) (take n variables))
++ ")\n => HTypeable ("++ typename n 26 ++")\n where"
++ " toHType m = Defined \""++constructor 1 n++"\" [] []"
++ "\n\ninstance "++ format 10 78 10 "(" ","
(map ("XmlContent "++) (take n variables))
++ ")\n => XmlContent ("++ typename n 26 ++")\n where"
++ "\n parseContents ="
++ "\n "++ format 7 78 7 " (" " $ "
(map (\v->"choice "++constructor v n) [1..n])
++ "\n $ fail \""++constructor 1 n++"\")"
++ concatMap (\v->"\n toContents ("++constructor v n
++" x) = toContents x")
[1..n]
++ "\n\n----"
---- constructor names ----
typename :: Int -> Int -> String
typename n pos = constructor 1 n ++ format pos 78 pos " " " " (take n variables)
constructor :: Int -> Int -> String
constructor n m = ordinal n ++"Of" ++ show m
ordinal :: Int -> String
ordinal n | n <= 20 = ordinals!!n
ordinal n | otherwise = "Choice"++show n
ordinals = ["Zero","One","Two","Three","Four","Five","Six","Seven","Eight"
,"Nine","Ten","Eleven","Twelve","Thirteen","Fourteen","Fifteen"
,"Sixteen","Seventeen","Eighteen","Nineteen","Twenty"]
---- variable names ----
variables = [ v:[] | v <- ['a'..'z']]
++ [ v:w:[] | v <- ['a'..'z'], w <- ['a'..'z']]
---- simple pretty-printing ----
format :: Int -- current position on page
-> Int -- maximum width of page
-> Int -- amount to indent when a newline is emitted
-> String -- text to precede first value
-> String -- text to precede subsequent values
-> [String] -- list of values to format
-> String
format cur max ind s0 s1 [] = ""
format cur max ind s0 s1 (x:xs)
| sameline < max = s0 ++ x ++ format sameline max ind s1 s1 xs
| otherwise = "\n" ++ replicate ind ' ' ++
s0 ++ x ++ format newline max ind s1 s1 xs
where sameline = cur + length s0 + length x
newline = ind + length s0 + length x
---- safe integer parsing ----
saferead :: String -> IO Int
saferead s | all isDigit s = return (read s)
saferead s | otherwise = error ("expected a number on the commandline, "
++"but got \""++s++"\" instead")
|