magic-haskell (1.0.8-8) utils/genconsts.hs

--- magic-haskell-1.0.8.orig/utils/genconsts.hs
+++ magic-haskell-1.0.8/utils/genconsts.hs
@@ -0,0 +1,66 @@
+{- -*- Mode: haskell; -*-
+Haskell Magic Interface
+Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>
+
+This code is under a 3-clause BSD license; see COPYING for details.
+-}
+
+import Data.Char
+import Data.List
+
+const2HS (x:xs) =
+    x : c2hs xs
+    where c2hs [] = []
+          c2hs ('_':x:xs) = x : c2hs xs
+          c2hs (x:xs) = toLower x : c2hs xs
+
+getC const = "#{const " ++ const ++ "}"
+
+errorClause name consts =
+    "data " ++ name ++ " =\n   " ++
+    concat (intersperse "\n | " (map toDecl consts)) ++
+    "\n | Unknown" ++ name ++ " Int\n" ++
+    "\n deriving (Show)" ++
+    "\n\ninstance Enum " ++ name ++ " where\n" ++
+    concat (intersperse "\n" (map toenums consts)) ++
+    "\n toEnum x = Unknown" ++ name ++ " x\n" ++
+    "\n" ++ concat (intersperse "\n" (map fromenums consts)) ++
+    "\n fromEnum (Unknown" ++ name ++ " x) = x\n" ++
+    "\ninstance Ord " ++ name ++ " where\n" ++
+    " compare x y = compare (fromEnum x) (fromEnum y)\n\n" ++
+    "instance Eq " ++ name ++ " where\n" ++
+    " x == y = (fromEnum x) == (fromEnum y)\n\n"
+    where
+    toDecl = const2HS
+    toenums i = 
+        " toEnum (" ++ getC i ++ ") = " ++ (const2HS i)
+    fromenums i = 
+        " fromEnum " ++ (const2HS i) ++ " = (" ++ getC i ++ ")"
+
+modHeader = 
+ "-- AUTO-GENERATED FILE, DO NOT EDIT.  GENERATED BY utils/genconsts.hs\n" ++
+ "{- |\n" ++
+ "   Module     : Magic.Data\n" ++
+ "   Copyright  : Copyright (C) 2005 John Goerzen\n" ++
+ "   License    : BSD\n" ++
+ "\n" ++
+ "   Maintainer : John Goerzen,\n" ++
+ "   Maintainer : jgoerzen@complete.org\n" ++
+ "   Stability  : provisional\n" ++
+ "   Portability: portable\n" ++
+ "\n" ++
+ "Haskell types for libmagic constants\n" ++
+ "\n" ++
+ "Written by John Goerzen, jgoerzen\\@complete.org\n" ++
+ "-}\n\n" ++
+ "module Magic.Data (module Magic.Data) where\n" ++
+ "\n#include \"magic.h\"\n\n"
+
+main = 
+    do putStrLn modHeader
+       putStrLn (errorClause "MagicFlag" magicFlags)
+
+magicFlags = ["MAGIC_NONE", "MAGIC_DEBUG", "MAGIC_SYMLINK",
+              "MAGIC_COMPRESS", "MAGIC_DEVICES", "MAGIC_MIME",
+              "MAGIC_CONTINUE", "MAGIC_CHECK",
+              "MAGIC_PRESERVE_ATIME", "MAGIC_RAW", "MAGIC_ERROR"]