module Main where
import Prelude hiding (max)
import System (getArgs,exitWith,ExitCode(..))
import Char (isDigit)
import IO (hFlush,stdout)
import Control.Monad (when)
import Text.XML.HaXml (version)
main :: IO ()
main = do
args <- getArgs
when ("--version" `elem` args) $ do
putStrLn $ "part of HaXml-"++version
exitWith ExitSuccess
when ("--help" `elem` args) $ do
putStrLn $ "See http://haskell.org/HaXml"
exitWith ExitSuccess
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
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----"
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 :: [String]
ordinals = ["Zero","One","Two","Three","Four","Five","Six","Seven","Eight"
,"Nine","Ten","Eleven","Twelve","Thirteen","Fourteen","Fifteen"
,"Sixteen","Seventeen","Eighteen","Nineteen","Twenty"]
variables :: [String]
variables = [ v:[] | v <- ['a'..'z']]
++ [ v:w:[] | v <- ['a'..'z'], w <- ['a'..'z']]
format :: Int
-> Int
-> Int
-> String
-> String
-> [String]
-> 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
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")