geniconvert (empty) → 0.15
raw patch · 7 files changed
+1469/−0 lines, 7 filesdep +HUnitdep +HaXmldep +QuickChecksetup-changed
Dependencies added: HUnit, HaXml, QuickCheck, base, binary, containers, haskell98, libGenI, mtl, parsec
Files
- Converter.hs +311/−0
- LICENSE +340/−0
- NLP/GenI/Converter/ReadTagml.hs +235/−0
- NLP/GenI/Converter/XmgTagml.hs +436/−0
- NLP/GenI/HsShow.lhs +124/−0
- Setup.lhs +4/−0
- geniconvert.cabal +19/−0
+ Converter.hs view
@@ -0,0 +1,311 @@+{-+GenI surface realiser+Copyright (C) 2005 Carlos Areces and Eric Kow++This program is free software; you can redistribute it and/or+modify it under the terms of the GNU General Public License+as published by the Free Software Foundation; either version 2+of the License, or (at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+-}++-- This module is meant to act as a standalone program which serves+-- strictly as a converter between the formats recognised by GenI.++module Main (main) where++import Control.Monad+import Data.Binary (decodeFile, encodeFile)+import Data.List+import Data.Maybe+import System (ExitCode(ExitFailure), exitWith, getArgs, getProgName)+import System.Console.GetOpt(OptDescr(Option), ArgDescr(..), usageInfo, getOpt, ArgOrder(Permute))+import System.IO(getContents)+import System.IO.Unsafe(unsafeInterleaveIO)+import Text.ParserCombinators.Parsec++import NLP.GenI.Btypes+import NLP.GenI.BtypesBinary ()+import NLP.GenI.General+import NLP.GenI.GeniParsers+import NLP.GenI.GeniShow+import NLP.GenI.HsShow (hsShow)+import NLP.GenI.Converter.ReadTagml (readTagmlMacros)++main :: IO ()+main =+ do args <- getArgs+ progname <- getProgName+ case getOpt Permute options args of+ (o,fs,[] ) -> convert (toInputParams o) fs+ _ -> showUsage progname+ where+ showUsage p = do+ let header = "usage: " ++ p ++ " [--macros|--lexicon|--morphlexicon] -f [tagml|geni] -t [haskell|geni|genib] -o output < input"+ ePutStrLn $ usageInfo header options+ exitWith (ExitFailure 1)++convert :: InputParams -> [FilePath] -> IO ()+convert (InputParams iForm oForm f iType) fs =+ do iFormat <- case getFormat iForm of+ Nothing -> fail $ "Unknown input format: " ++ iForm+ Just fo -> return fo+ oFormat <- case getFormat oForm of+ Nothing -> fail $ "Unknown output format: " ++ oForm+ Just fo -> return fo+ when (null f) $+ fail $ "Sorry, you must specify an output file with -o"+ when (oFormat `elem` [ haskellFormat, genibFormat ] && length fs > 1) $+ fail $ "Sorry, I can't convert more than one file to " ++ showFormat oFormat ++ " at a time"+ -- empty out the file first! (there might be an old one lying around)+ writeFile f ""+ --+ let getParser p = maybe (oops iFormat "parse") textReader $ p iFormat+ getReader r = fromMaybe (oops iFormat "read") $ r iFormat+ getWriter w = fromMaybe (oops oFormat "write") $ w oFormat+ oops format d =+ fail $ unwords [ "Sorry, I don't know how to", d, show iType, "in the", showFormat format, "format" ]+ let convertString x = case iType of+ MacrosItype -> getParser parseMacros x >>= (getWriter writeMacros f)+ LexiconItype -> getParser parseLexicon x >>= (getWriter writeLexicon f)+ MorphLexiconItype -> getParser parseMorphLexicon x >>= (getWriter writeMorphLexicon f)+ convertFile x = case iType of+ MacrosItype -> getReader readMacros x >>= (getWriter writeMacros f)+ LexiconItype -> getReader readLexicon x >>= (getWriter writeLexicon f)+ MorphLexiconItype -> getReader readMorphLexicon x >>= (getWriter writeMorphLexicon f)+ if null fs+ then getContents >>= convertString+ else forM_ fs $ (\x -> unsafeInterleaveIO (readFile x) >>= convertFile)++-- -------------------------------------------------------------------+-- command line arguments+-- -------------------------------------------------------------------++data Flag = FromFlg String | ToFlg String | OutputFlg String+ | MacrosFlg | LexiconFlg | MorphLexiconFlg+ deriving (Eq)++options :: [OptDescr Flag]+options =+ [ Option "f" ["from"] (ReqArg FromFlg "TYPE") "tagml|geni"+ , Option "t" ["to"] (ReqArg ToFlg "TYPE") "haskell|geni|genib"+ , Option "o" ["output"] (ReqArg OutputFlg "STRING") "output file, or -t haskell, prefix for output files"+ --+ , Option "" ["macros"] (NoArg MacrosFlg)"input file is a macros file (default)"+ , Option "" ["lexicon"] (NoArg LexiconFlg) "input file is a lexicon file"+ , Option "" ["morphlexicon"] (NoArg MorphLexiconFlg) "input file is a morphological lexicon"+ ]++data InputType = MacrosItype | LexiconItype | MorphLexiconItype++instance Show InputType where+ show MacrosItype = "macros"+ show LexiconItype = "lexicons"+ show MorphLexiconItype = "morphological lexicons"++data InputParams = InputParams { fromArg :: String+ , toArg :: String+ , stemArg :: String+ , itype :: InputType+ }++defaultParams :: InputParams+defaultParams = InputParams "" "" "" MacrosItype++toInputParams :: [Flag] -> InputParams+toInputParams fs = foldr ($) defaultParams $ map processFlag fs++processFlag :: Flag -> InputParams -> InputParams+processFlag (FromFlg x) = \p -> p { fromArg = x }+processFlag (ToFlg x) = \p -> p { toArg = x }+processFlag (OutputFlg x) = \p -> p { stemArg = x }+processFlag MacrosFlg = \p -> p { itype = MacrosItype }+processFlag LexiconFlg = \p -> p { itype = LexiconItype }+processFlag MorphLexiconFlg = \p -> p { itype = MorphLexiconItype }++-- -------------------------------------------------------------------+-- formats+-- -------------------------------------------------------------------++type TextParser a = String -> Either String a+type FileReader a = FilePath -> IO a+type FileWriter a = FilePath -> a -> IO ()++data FileFormat = FileFormat+ { showFormat :: String+ --+ , parseMacros :: Maybe (TextParser Macros)+ , readMacros :: Maybe (FileReader Macros)+ , writeMacros :: Maybe (FileWriter Macros)+ --+ , parseLexicon :: Maybe (TextParser [ILexEntry])+ , readLexicon :: Maybe (FileReader [ILexEntry])+ , writeLexicon :: Maybe (FileWriter [ILexEntry])+ --+ , parseMorphLexicon :: Maybe (TextParser [MorphLexEntry])+ , readMorphLexicon :: Maybe (FileReader [MorphLexEntry])+ , writeMorphLexicon :: Maybe (FileWriter [MorphLexEntry])+ }++instance Eq FileFormat where+ a == b = showFormat a == showFormat b++wrapParsec :: CharParser () a -> (String -> Either String a)+wrapParsec p lf = either (Left . show) (Right) (parse p "" lf)++textReader :: (String -> Either String a) -> String -> IO a+textReader p lf = either fail return (p lf)++getFormat :: String -> Maybe FileFormat+getFormat x = listToMaybe [ f | f <- formats, x == showFormat f ]++formats :: [FileFormat]+formats = [ tagmlFormat, geniFormat, genibFormat, haskellFormat ]++-- -------------------------------------------------------------------+-- tagml format+-- -------------------------------------------------------------------++tagmlFormat :: FileFormat+tagmlFormat = FileFormat+ { showFormat = "tagml"+ , parseMacros = pMacros+ , readMacros = fmap textReader pMacros+ , writeMacros = Nothing+ --+ , parseLexicon = pLex+ , readLexicon = fmap textReader pLex+ , writeLexicon = Nothing+ --+ , parseMorphLexicon = pMorphLex+ , readMorphLexicon = fmap textReader pMorphLex+ , writeMorphLexicon = Nothing+ }+ where+ pMacros = Just $ readTagmlMacros+ pLex = Nothing+ pMorphLex = Nothing++-- -------------------------------------------------------------------+-- geni format+-- -------------------------------------------------------------------++geniFormat :: FileFormat+geniFormat = FileFormat+ { showFormat = "geni"+ --+ , parseMacros = pMacros+ , readMacros = fmap textReader pMacros+ , writeMacros = Just geniWriter+ --+ , parseLexicon = pLex+ , readLexicon = fmap textReader pLex+ , writeLexicon = Nothing+ --+ , parseMorphLexicon = pMorphLex+ , readMorphLexicon = fmap textReader pMorphLex+ , writeMorphLexicon = Nothing+ }+ where+ pMacros = Just $ wrapParsec geniMacros+ pLex = Just $ wrapParsec geniLexicon+ pMorphLex = Just $ wrapParsec geniMorphLexicon++geniWriter :: GeniShow a => FilePath -> [a] -> IO ()+geniWriter mf ms = appendFile mf $ unlines $ map geniShow ms++-- -------------------------------------------------------------------+-- genib format+-- -------------------------------------------------------------------++genibFormat :: FileFormat+genibFormat = FileFormat+ { showFormat = "genib"+ --+ , parseMacros = Nothing+ , readMacros = Just decodeFile+ , writeMacros = Just encodeFile+ --+ , parseLexicon = Nothing+ , readLexicon = Just decodeFile+ , writeLexicon = Just encodeFile+ --+ , parseMorphLexicon = Nothing+ , readMorphLexicon = Just decodeFile+ , writeMorphLexicon = Just encodeFile+ }++-- -------------------------------------------------------------------+-- haskell macros file+-- -------------------------------------------------------------------++haskellFormat :: FileFormat+haskellFormat = FileFormat+ { showFormat = "haskell"+ --+ , parseMacros = Nothing+ , readMacros = Nothing+ , writeMacros = Just writeHaskellMacros+ --+ , parseLexicon = Nothing+ , readLexicon = Nothing+ , writeLexicon = Nothing+ --+ , parseMorphLexicon = Nothing+ , readMorphLexicon = Nothing+ , writeMorphLexicon = Nothing+ }++writeHaskellMacros :: String -> Macros -> IO ()+writeHaskellMacros rawStem ms =+ do let tpairs = zip [1::Integer ..] ms+ stem = toUpperHead rawStem+ -- write the sub files+ let chunks = everyN 15 tpairs+ chunkIds = take (length chunks) [1::Int ..]+ sequence $ zipWith (writeChunk stem) chunkIds chunks+ -- write the main file+ writeFile (stem ++ ".hs") $ unlines $+ [ "module " ++ stem ++ "(myGeniGrammar) where"+ , "import NLP.GenI.Btypes"+ , "" ] +++ map (\i -> "import " ++ stem ++ (show i)) chunkIds +++ [ ""+ , "myGeniGrammar :: [MTtree]"+ , "myGeniGrammar = "+ , " [" ++ (uncommas $ map valName tpairs)+ , " ]" ]++writeChunk :: String -> Int -> [(Integer,MTtree)] -> IO ()+writeChunk stem n tps =+ let filename = stem ++ (show n) ++ ".hs"+ modulename = stem ++ (show n)+ treenames = uncommas $ map valName tps+ in writeFile filename $+ unlines $ [ "module " ++ modulename ++ "(" ++ treenames ++ ") where"+ , "import Data.Tree"+ , "import NLP.GenI.Btypes"+ , ""+ , treenames ++ " :: MTtree"+ , "" ] +++ (intersperse "" $ map (\ (i,t) -> valName (i,t) ++ " = " ++ hsShow t) tps)++valName :: (Integer, MTtree) -> String+valName (i,t) = "t" ++ (show i) ++ "_" ++ (pfamily t)++-- | Break a list up in to n sized chunks; the last element of the list might+-- be somewhat smaller, eh?+everyN :: Int -> [a] -> [[a]]+everyN _ [] = []+everyN n xs = take n xs : (everyN n $ drop n xs)++uncommas :: [String] -> String+uncommas = concat . (intersperse ", ")
+ LICENSE view
@@ -0,0 +1,340 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.
+ NLP/GenI/Converter/ReadTagml.hs view
@@ -0,0 +1,235 @@+{-+GenI surface realiser+Copyright (C) 2006 Carlos Areces and Eric Kow++This program is free software; you can redistribute it and/or+modify it under the terms of the GNU General Public License+as published by the Free Software Foundation; either version 2+of the License, or (at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+-}++module NLP.GenI.Converter.ReadTagml where++import Data.Char+import Data.List (sort,delete,find)+import Data.Tree+import Control.Monad.State (State, runState, get, put)+import Text.XML.HaXml.XmlContent+import Text.XML.HaXml.ParseLazy (xmlParse)+import Text.XML.HaXml.Posn (posInNewCxt)++import NLP.GenI.Btypes+ ( AvPair, Flist+ , GType(Subs,Foot,Lex,Other)+ , GNode(..), Macros, Ttree(..)+ , GeniVal(GConst, GVar, GAnon), fromGConst, lexemeAttributes+ , emptyMacro, Ptype(..), Pred, Sem)+-- import NLP.GenI.Tags(emptyTE,TagElem(..),Tags,TagSite,addToTags)+import qualified NLP.GenI.Converter.XmgTagml as X ++-- ======================================================================+-- Macros+-- ======================================================================++type MTree = Ttree GNode++readTagmlMacros :: String -> Either String Macros+readTagmlMacros g = + case readXmlLazy g of+ Right (X.GrammarEntry es) -> Right $ map translateEntry es+ _ -> Left "Not a TAGML grammar entry"++translateEntry :: X.Entry -> MTree+translateEntry (X.Entry (X.Entry_Attrs tname) (X.Family family) (X.Trace trace) t sem (X.Interface iface)) =+ let ifeats = case iface of+ Nothing -> []+ Just ifs -> translateFlatFs ifs+ fromClass (X.Class s) = s+ in (translateTree t) { pfamily = family+ , pidname = tname+ , params = []+ , pinterface = ifeats+ , ptrace = map fromClass trace+ , psemantics = Just $ translateSemantics sem }++-- | From HaXmL+-- Read a fully-typed XML document from a string.+readXmlLazy :: XmlContent a => String -> Either String a+readXmlLazy s =+ let (Document _ _ y _) = xmlParse "string input" s in+ fst (runParser parseContents+ [CElem y (posInNewCxt "string input" Nothing)])+-- ----------------------------------------------------------------------+-- Syntax+-- ----------------------------------------------------------------------++data TreeInfo = TI {+ tiNum :: Int,+ tiHasFoot :: Bool+} ++-- Tree parsing consists of building up the tree with the recursive+-- function translateNode, and then extracting (from the State monad)+-- some information which is global to the tree.+translateTree :: X.Tree -> MTree+translateTree (X.Tree _ root) =+ let initTi = TI { tiNum = 0, tiHasFoot = False }+ (tr,info) = runState (translateNode root) initTi+ in emptyMacro { tree = tr+ , ptype = if tiHasFoot info then Auxiliar else Initial+ }++-- We recurse through a basic tree structure to build the TAG tree.+-- The annoying thing is the features. The MG builds recursive feature+-- structures, where the top and bottom features are substructures of+-- the global fs. GenI, on the other hand, assumes two flat feature+-- lists, top and bottom. We work around this by simply assuming that+-- the fs recursion never goes further than that one level, and that+-- global features belong to both the top and bottom lists.+translateNode :: X.Node -> State TreeInfo (Tree GNode)+translateNode node@(X.Node _ _ kids) = do+ st <- get+ -- update the monadic state+ let idnum = tiNum st+ gn = translateNodeHelper idnum node+ put $ st { tiNum = idnum + 1,+ -- tiLex = if ntype == Lex then lex else (tiLex st),+ tiHasFoot = tiHasFoot st || gtype gn == Foot }+ -- recursion to the kids + kidsOut <- mapM translateNode kids+ -- output the node+ return $! Node gn kidsOut++translateNodeHelper :: Int -> X.Node -> GNode+translateNodeHelper idnum (X.Node nattrs mnargs _) = gn where+ allFs = case mnargs of+ Nothing -> []+ Just (X.Narg n) -> translateFs n+ --+ recursiveNamed x (Node (Left n) _) = n == x+ recursiveNamed _ _ = False+ topF_ = find (recursiveNamed "top") allFs+ botF_ = find (recursiveNamed "bot") allFs+ gloF_ = case topF_ of+ Nothing -> gloF_'+ Just t -> delete t gloF_'+ where gloF_' = case botF_ of+ Nothing -> allFs+ Just b -> delete b allFs+ --+ mflattenFs mfs = case mfs of Nothing -> []+ Just fs -> flattenFs fs+ topF = mflattenFs topF_+ botF = mflattenFs botF_+ gloF = concatMap flattenFs gloF_+ -- reading the node type+ ntype = case X.nodeType nattrs of+ X.Node_type_subst -> Subs+ X.Node_type_foot -> Foot+ X.Node_type_anchor -> Lex+ X.Node_type_coanchor -> Lex+ X.Node_type_lex -> Lex+ X.Node_type_std -> Other+ X.Node_type_nadj -> Other+ -- figuring out what the lexeme might be+ -- (we a list of distinguished attributes, in order of preference)+ lexL = concat $ map (\la -> [ v | (a,v) <- gloF, a == la ])+ lexemeAttributes+ lexeme = case (ntype,lexL) of+ (Lex,h:_) -> fromGConst h+ _ -> []+ anchor = X.nodeType nattrs == X.Node_type_anchor+ aconstr = case X.nodeType nattrs of+ X.Node_type_subst -> True+ X.Node_type_foot -> True+ X.Node_type_nadj -> True+ _ -> False+ -- the node name is either the counter or something hardset+ name = case X.nodeName nattrs of+ Nothing -> 'n' : (show idnum)+ Just n -> n+ -- saving the results in a Gnode+ gn = GN { gnname = name,+ gup = sort $ topF ++ gloF,+ gdown = sort $ botF ++ gloF,+ ganchor = anchor,+ glexeme = if anchor then [] else lexeme,+ gtype = ntype,+ gaconstr = aconstr,+ gorigin = "" }++-- ----------------------------------------------------------------------+-- Semantics+-- ----------------------------------------------------------------------++translateSemantics :: X.Semantics -> Sem+translateSemantics (X.Semantics ls) = map translateSemantics_ ls++translateSemantics_ :: X.Semantics_ -> Pred+translateSemantics_ (X.Semantics_Literal l) = translateLiteral l+translateSemantics_ _ = geniXmlError "fancy semantics not supported"++translateLiteral :: X.Literal -> Pred+translateLiteral (X.Literal _ mlabel (X.Predicate pr) args) =+ let label = case mlabel of+ Nothing -> GAnon+ Just (X.Label s) -> translateSym s+ in (label, translateSym pr, map translateArg args)++translateArg :: X.Arg -> GeniVal+translateArg (X.ArgSym s) = translateSym s+translateArg (X.ArgFs _) = geniXmlError "complex semantic arguments not supported"++-- ----------------------------------------------------------------------+-- Features+-- ----------------------------------------------------------------------++type FsTreeNode = Either String AvPair++translateFs :: X.Fs -> Forest FsTreeNode +translateFs (X.Fs _ fs) = map translateF fs++translateF :: X.F -> Tree FsTreeNode+translateF (X.FFs attr fs) = Node (Left (X.fName attr)) (translateFs fs)+translateF (X.FSym attr s) = Node (Right (X.fName attr, translateSym s)) []+translateF (X.FVAlt attr d) = Node (Right (X.fName attr, translateVAlt d)) []++flattenFs :: Tree FsTreeNode -> [AvPair]+flattenFs = catMaybes . (map fromRight) . flatten+ where fromRight (Right r) = Just r+ fromRight _ = Nothing++translateFlatFs :: X.Fs -> Flist+translateFlatFs (X.Fs _ fs) = map translateFlatF fs++translateFlatF :: X.F -> AvPair+translateFlatF (X.FFs _ _) = error "translateFlatF called on recursive F"+translateFlatF (X.FSym attr s) = (X.fName attr, translateSym s)+translateFlatF (X.FVAlt attr d) = (X.fName attr, translateVAlt d)++translateSym :: X.Sym -> GeniVal+translateSym s = + case X.symValue s of + Just c -> GConst [c]+ Nothing -> + case X.symVarname s of+ Just v -> GVar $ drop 1 v -- drop the '@'+ Nothing -> geniXmlError "translateSym on sym which is neither value nor varname"++-- atomic disjunction+translateVAlt :: X.VAlt -> GeniVal+translateVAlt (X.VAlt _ (NonEmpty ss)) = GConst $ map (fromJ.(X.symValue)) ss + where fromJ (Just n) = n+ fromJ _ = geniXmlError "atomic disjunction with non atomic component"++geniXmlError :: String -> a+geniXmlError s = error $ "GenI XML error: " ++ s
+ NLP/GenI/Converter/XmgTagml.hs view
@@ -0,0 +1,436 @@+{-# OPTIONS_GHC -w #-}+module NLP.GenI.Converter.XmgTagml where++import Text.XML.HaXml.XmlContent+import Text.XML.HaXml.OneOfN+++{-Type decls-}++data Grammar = GrammarEntry [Entry]+ | GrammarSubgrammar [Subgrammar]+ deriving (Eq,Show)+data Subgrammar = Subgrammar Subgrammar_Attrs [Entry]+ deriving (Eq,Show)+data Subgrammar_Attrs = Subgrammar_Attrs+ { subgrammarId :: String+ } deriving (Eq,Show)+data Entry = Entry Entry_Attrs Family Trace Tree Semantics+ Interface+ deriving (Eq,Show)+data Entry_Attrs = Entry_Attrs+ { entryName :: String+ } deriving (Eq,Show)+newtype Family = Family String deriving (Eq,Show)+newtype Trace = Trace [Class] deriving (Eq,Show)+newtype Class = Class String deriving (Eq,Show)+data Tree = Tree Tree_Attrs Node+ deriving (Eq,Show)+data Tree_Attrs = Tree_Attrs+ { treeId :: String+ } deriving (Eq,Show)+data Node = Node Node_Attrs (Maybe Narg) [Node]+ deriving (Eq,Show)+data Node_Attrs = Node_Attrs+ { nodeType :: Node_type+ , nodeName :: (Maybe String)+ } deriving (Eq,Show)+data Node_type = Node_type_nadj | Node_type_std | + Node_type_subst | Node_type_lex | Node_type_anchor | + Node_type_coanchor | Node_type_foot+ deriving (Eq,Show)+newtype Narg = Narg Fs deriving (Eq,Show)+data Fs = Fs Fs_Attrs [F]+ deriving (Eq,Show)+data Fs_Attrs = Fs_Attrs+ { fsCoref :: (Maybe String)+ } deriving (Eq,Show)+data F = FSym F_Attrs Sym+ | FVAlt F_Attrs VAlt+ | FFs F_Attrs Fs+ deriving (Eq,Show)+data F_Attrs = F_Attrs+ { fName :: String+ } deriving (Eq,Show)+data VAlt = VAlt VAlt_Attrs (List1 Sym)+ deriving (Eq,Show)+data VAlt_Attrs = VAlt_Attrs+ { vAltCoref :: (Defaultable String)+ } deriving (Eq,Show)+data Sym = Sym+ { symValue :: (Maybe String)+ , symVarname :: (Maybe String)+ } deriving (Eq,Show)+newtype Semantics = Semantics [Semantics_] deriving (Eq,Show)+data Semantics_ = Semantics_Literal Literal+ | Semantics_Sym Sym+ | Semantics_Semdominance Semdominance+ deriving (Eq,Show)+data Literal = Literal Literal_Attrs (Maybe Label) Predicate [Arg]+ deriving (Eq,Show)+data Literal_Attrs = Literal_Attrs+ { literalNegated :: (Defaultable String)+ } deriving (Eq,Show)+newtype Label = Label Sym deriving (Eq,Show)+newtype Predicate = Predicate Sym deriving (Eq,Show)+data Arg = ArgSym Sym+ | ArgFs Fs+ deriving (Eq,Show)+data Semdominance = Semdominance Semdominance_Attrs (List1 Arg)+ deriving (Eq,Show)+data Semdominance_Attrs = Semdominance_Attrs+ { semdominanceOp :: (Defaultable String)+ } deriving (Eq,Show)+newtype Interface = Interface (Maybe Fs) deriving (Eq,Show)+++{-Instance decls-}++instance HTypeable Grammar where+ toHType x = Defined "grammar" [] []+instance XmlContent Grammar where+ toContents (GrammarEntry a) =+ [CElem (Elem "grammar" [] (concatMap toContents a) ) ()]+ toContents (GrammarSubgrammar a) =+ [CElem (Elem "grammar" [] (concatMap toContents a) ) ()]+ parseContents = do + { e@(Elem _ [] _) <- element ["grammar"]+ ; interior e $ oneOf+ [ return (GrammarEntry) `apply` many parseContents+ , return (GrammarSubgrammar) `apply` many parseContents+ ] `adjustErr` ("in <grammar>, "++)+ }++instance HTypeable Subgrammar where+ toHType x = Defined "subgrammar" [] []+instance XmlContent Subgrammar where+ toContents (Subgrammar as a) =+ [CElem (Elem "subgrammar" (toAttrs as) (concatMap toContents a)) ()]+ parseContents = do+ { e@(Elem _ as _) <- element ["subgrammar"]+ ; interior e $ return (Subgrammar (fromAttrs as))+ `apply` many parseContents+ } `adjustErr` ("in <subgrammar>, "++)+instance XmlAttributes Subgrammar_Attrs where+ fromAttrs as =+ Subgrammar_Attrs+ { subgrammarId = definiteA fromAttrToStr "subgrammar" "id" as+ }+ toAttrs v = catMaybes + [ toAttrFrStr "id" (subgrammarId v)+ ]++instance HTypeable Entry where+ toHType x = Defined "entry" [] []+instance XmlContent Entry where+ toContents (Entry as a b c d e) =+ [CElem (Elem "entry" (toAttrs as) (toContents a ++ toContents b +++ toContents c ++ toContents d ++ toContents e)) ()]+ parseContents = do+ { e@(Elem _ as _) <- element ["entry"]+ ; interior e $ return (Entry (fromAttrs as)) `apply` parseContents+ `apply` parseContents `apply` parseContents `apply` parseContents+ `apply` parseContents+ } `adjustErr` ("in <entry>, "++)+instance XmlAttributes Entry_Attrs where+ fromAttrs as =+ Entry_Attrs+ { entryName = definiteA fromAttrToStr "entry" "name" as+ }+ toAttrs v = catMaybes + [ toAttrFrStr "name" (entryName v)+ ]++instance HTypeable Family where+ toHType x = Defined "family" [] []+instance XmlContent Family where+ toContents (Family a) =+ [CElem (Elem "family" [] (toText a)) ()]+ parseContents = do+ { e@(Elem _ [] _) <- element ["family"]+ ; interior e $ return (Family) `apply` (text `onFail` return "")+ } `adjustErr` ("in <family>, "++)++instance HTypeable Trace where+ toHType x = Defined "trace" [] []+instance XmlContent Trace where+ toContents (Trace a) =+ [CElem (Elem "trace" [] (concatMap toContents a)) ()]+ parseContents = do+ { e@(Elem _ [] _) <- element ["trace"]+ ; interior e $ return (Trace) `apply` many parseContents+ } `adjustErr` ("in <trace>, "++)++instance HTypeable Class where+ toHType x = Defined "class" [] []+instance XmlContent Class where+ toContents (Class a) =+ [CElem (Elem "class" [] (toText a)) ()]+ parseContents = do+ { e@(Elem _ [] _) <- element ["class"]+ ; interior e $ return (Class) `apply` (text `onFail` return "")+ } `adjustErr` ("in <class>, "++)++instance HTypeable Tree where+ toHType x = Defined "tree" [] []+instance XmlContent Tree where+ toContents (Tree as a) =+ [CElem (Elem "tree" (toAttrs as) (toContents a)) ()]+ parseContents = do+ { e@(Elem _ as _) <- element ["tree"]+ ; interior e $ return (Tree (fromAttrs as)) `apply` parseContents+ } `adjustErr` ("in <tree>, "++)+instance XmlAttributes Tree_Attrs where+ fromAttrs as =+ Tree_Attrs+ { treeId = definiteA fromAttrToStr "tree" "id" as+ }+ toAttrs v = catMaybes + [ toAttrFrStr "id" (treeId v)+ ]++instance HTypeable Node where+ toHType x = Defined "node" [] []+instance XmlContent Node where+ toContents (Node as a b) =+ [CElem (Elem "node" (toAttrs as) (maybe [] toContents a +++ concatMap toContents b)) ()]+ parseContents = do+ { e@(Elem _ as _) <- element ["node"]+ ; interior e $ return (Node (fromAttrs as))+ `apply` optional parseContents `apply` many parseContents+ } `adjustErr` ("in <node>, "++)+instance XmlAttributes Node_Attrs where+ fromAttrs as =+ Node_Attrs+ { nodeType = definiteA fromAttrToTyp "node" "type" as+ , nodeName = possibleA fromAttrToStr "name" as+ }+ toAttrs v = catMaybes + [ toAttrFrTyp "type" (nodeType v)+ , maybeToAttr toAttrFrStr "name" (nodeName v)+ ]++instance XmlAttrType Node_type where+ fromAttrToTyp n (n',v)+ | n==n' = translate (attr2str v)+ | otherwise = Nothing+ where translate "nadj" = Just Node_type_nadj+ translate "std" = Just Node_type_std+ translate "subst" = Just Node_type_subst+ translate "lex" = Just Node_type_lex+ translate "anchor" = Just Node_type_anchor+ translate "coanchor" = Just Node_type_coanchor+ translate "foot" = Just Node_type_foot+ translate _ = Nothing+ toAttrFrTyp n Node_type_nadj = Just (n, str2attr "nadj")+ toAttrFrTyp n Node_type_std = Just (n, str2attr "std")+ toAttrFrTyp n Node_type_subst = Just (n, str2attr "subst")+ toAttrFrTyp n Node_type_lex = Just (n, str2attr "lex")+ toAttrFrTyp n Node_type_anchor = Just (n, str2attr "anchor")+ toAttrFrTyp n Node_type_coanchor = Just (n, str2attr "coanchor")+ toAttrFrTyp n Node_type_foot = Just (n, str2attr "foot")++instance HTypeable Narg where+ toHType x = Defined "narg" [] []+instance XmlContent Narg where+ toContents (Narg a) =+ [CElem (Elem "narg" [] (toContents a)) ()]+ parseContents = do+ { e@(Elem _ [] _) <- element ["narg"]+ ; interior e $ return (Narg) `apply` parseContents+ } `adjustErr` ("in <narg>, "++)++instance HTypeable Fs where+ toHType x = Defined "fs" [] []+instance XmlContent Fs where+ toContents (Fs as a) =+ [CElem (Elem "fs" (toAttrs as) (concatMap toContents a)) ()]+ parseContents = do+ { e@(Elem _ as _) <- element ["fs"]+ ; interior e $ return (Fs (fromAttrs as))+ `apply` many parseContents+ } `adjustErr` ("in <fs>, "++)+instance XmlAttributes Fs_Attrs where+ fromAttrs as =+ Fs_Attrs+ { fsCoref = possibleA fromAttrToStr "coref" as+ }+ toAttrs v = catMaybes + [ maybeToAttr toAttrFrStr "coref" (fsCoref v)+ ]++instance HTypeable F where+ toHType x = Defined "f" [] []+instance XmlContent F where+ toContents (FSym as a) =+ [CElem (Elem "f" (toAttrs as) (toContents a) ) ()]+ toContents (FVAlt as a) =+ [CElem (Elem "f" (toAttrs as) (toContents a) ) ()]+ toContents (FFs as a) =+ [CElem (Elem "f" (toAttrs as) (toContents a) ) ()]+ parseContents = do + { e@(Elem _ as _) <- element ["f"]+ ; interior e $ oneOf+ [ return (FSym (fromAttrs as)) `apply` parseContents+ , return (FVAlt (fromAttrs as)) `apply` parseContents+ , return (FFs (fromAttrs as)) `apply` parseContents+ ] `adjustErr` ("in <f>, "++)+ }+instance XmlAttributes F_Attrs where+ fromAttrs as =+ F_Attrs+ { fName = definiteA fromAttrToStr "f" "name" as+ }+ toAttrs v = catMaybes + [ toAttrFrStr "name" (fName v)+ ]++instance HTypeable VAlt where+ toHType x = Defined "vAlt" [] []+instance XmlContent VAlt where+ toContents (VAlt as a) =+ [CElem (Elem "vAlt" (toAttrs as) (toContents a)) ()]+ parseContents = do+ { e@(Elem _ as _) <- element ["vAlt"]+ ; interior e $ return (VAlt (fromAttrs as)) `apply` parseContents+ } `adjustErr` ("in <vAlt>, "++)+instance XmlAttributes VAlt_Attrs where+ fromAttrs as =+ VAlt_Attrs+ { vAltCoref = defaultA fromAttrToStr "" "coref" as+ }+ toAttrs v = catMaybes + [ defaultToAttr toAttrFrStr "coref" (vAltCoref v)+ ]++instance HTypeable Sym where+ toHType x = Defined "sym" [] []+instance XmlContent Sym where+ toContents as =+ [CElem (Elem "sym" (toAttrs as) []) ()]+ parseContents = do+ { (Elem _ as []) <- element ["sym"]+ ; return (fromAttrs as)+ } `adjustErr` ("in <sym>, "++)+instance XmlAttributes Sym where+ fromAttrs as =+ Sym+ { symValue = possibleA fromAttrToStr "value" as+ , symVarname = possibleA fromAttrToStr "varname" as+ }+ toAttrs v = catMaybes + [ maybeToAttr toAttrFrStr "value" (symValue v)+ , maybeToAttr toAttrFrStr "varname" (symVarname v)+ ]++instance HTypeable Semantics where+ toHType x = Defined "semantics" [] []+instance XmlContent Semantics where+ toContents (Semantics a) =+ [CElem (Elem "semantics" [] (concatMap toContents a)) ()]+ parseContents = do+ { e@(Elem _ [] _) <- element ["semantics"]+ ; interior e $ return (Semantics) `apply` many parseContents+ } `adjustErr` ("in <semantics>, "++)++instance HTypeable Semantics_ where+ toHType x = Defined "semantics" [] []+instance XmlContent Semantics_ where+ toContents (Semantics_Literal a) = toContents a+ toContents (Semantics_Sym a) = toContents a+ toContents (Semantics_Semdominance a) = toContents a+ parseContents = oneOf+ [ return (Semantics_Literal) `apply` parseContents+ , return (Semantics_Sym) `apply` parseContents+ , return (Semantics_Semdominance) `apply` parseContents+ ] `adjustErr` ("in <semantics>, "++)++instance HTypeable Literal where+ toHType x = Defined "literal" [] []+instance XmlContent Literal where+ toContents (Literal as a b c) =+ [CElem (Elem "literal" (toAttrs as) (maybe [] toContents a +++ toContents b ++ concatMap toContents c)) ()]+ parseContents = do+ { e@(Elem _ as _) <- element ["literal"]+ ; interior e $ return (Literal (fromAttrs as))+ `apply` optional parseContents `apply` parseContents+ `apply` many parseContents+ } `adjustErr` ("in <literal>, "++)+instance XmlAttributes Literal_Attrs where+ fromAttrs as =+ Literal_Attrs+ { literalNegated = defaultA fromAttrToStr "no" "negated" as+ }+ toAttrs v = catMaybes + [ defaultToAttr toAttrFrStr "negated" (literalNegated v)+ ]++instance HTypeable Label where+ toHType x = Defined "label" [] []+instance XmlContent Label where+ toContents (Label a) =+ [CElem (Elem "label" [] (toContents a)) ()]+ parseContents = do+ { e@(Elem _ [] _) <- element ["label"]+ ; interior e $ return (Label) `apply` parseContents+ } `adjustErr` ("in <label>, "++)++instance HTypeable Predicate where+ toHType x = Defined "predicate" [] []+instance XmlContent Predicate where+ toContents (Predicate a) =+ [CElem (Elem "predicate" [] (toContents a)) ()]+ parseContents = do+ { e@(Elem _ [] _) <- element ["predicate"]+ ; interior e $ return (Predicate) `apply` parseContents+ } `adjustErr` ("in <predicate>, "++)++instance HTypeable Arg where+ toHType x = Defined "arg" [] []+instance XmlContent Arg where+ toContents (ArgSym a) =+ [CElem (Elem "arg" [] (toContents a) ) ()]+ toContents (ArgFs a) =+ [CElem (Elem "arg" [] (toContents a) ) ()]+ parseContents = do + { e@(Elem _ [] _) <- element ["arg"]+ ; interior e $ oneOf+ [ return (ArgSym) `apply` parseContents+ , return (ArgFs) `apply` parseContents+ ] `adjustErr` ("in <arg>, "++)+ }++instance HTypeable Semdominance where+ toHType x = Defined "semdominance" [] []+instance XmlContent Semdominance where+ toContents (Semdominance as a) =+ [CElem (Elem "semdominance" (toAttrs as) (toContents a)) ()]+ parseContents = do+ { e@(Elem _ as _) <- element ["semdominance"]+ ; interior e $ return (Semdominance (fromAttrs as))+ `apply` parseContents+ } `adjustErr` ("in <semdominance>, "++)+instance XmlAttributes Semdominance_Attrs where+ fromAttrs as =+ Semdominance_Attrs+ { semdominanceOp = defaultA fromAttrToStr "ge" "op" as+ }+ toAttrs v = catMaybes + [ defaultToAttr toAttrFrStr "op" (semdominanceOp v)+ ]++instance HTypeable Interface where+ toHType x = Defined "interface" [] []+instance XmlContent Interface where+ toContents (Interface a) =+ [CElem (Elem "interface" [] (maybe [] toContents a)) ()]+ parseContents = do+ { e@(Elem _ [] _) <- element ["interface"]+ ; interior e $ return (Interface) `apply` optional parseContents+ } `adjustErr` ("in <interface>, "++)++++{-Done-}
+ NLP/GenI/HsShow.lhs view
@@ -0,0 +1,124 @@+% GenI surface realiser+% Copyright (C) 2005 Carlos Areces and Eric Kow+%+% This program is free software; you can redistribute it and/or+% modify it under the terms of the GNU General Public License+% as published by the Free Software Foundation; either version 2+% of the License, or (at your option) any later version.+%+% This program is distributed in the hope that it will be useful,+% but WITHOUT ANY WARRANTY; without even the implied warranty of+% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+% GNU General Public License for more details.+%+% You should have received a copy of the GNU General Public License+% along with this program; if not, write to the Free Software+% Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.++\chapter{HsShow}++One idea I'm experimenting with is dumping the grammars into Haskell, haskell which will+need to be linked against GenI in order to produce a generator. This might make the whole+lexical selection thing og a lot faster.++\begin{code}+{-# LANGUAGE TypeSynonymInstances #-}+module NLP.GenI.HsShow+where+\end{code}++\ignore{+\begin{code}+import Data.Tree+import qualified Data.Map++import NLP.GenI.Tags+ ( TagElem(TE),+ )+import NLP.GenI.Btypes (GeniVal(GConst, GVar, GAnon), Ptype(..),+ Ttree(TT),+ GNode(..), GType(..),+ )+\end{code}+}++\begin{code}+class HsShow a where+ hsShow :: a -> String+ hsShow x = hsShows x ""+ hsShows :: a -> ShowS++hsParens, hsBrackets :: ShowS -> ShowS+hsParens fn = showChar '(' . fn . showChar ')'+hsBrackets fn = showChar '[' . fn . showChar ']'++unwordsByS :: ShowS -> [ShowS] -> ShowS+unwordsByS _ [] = id+unwordsByS sep ss = foldr1 (\s r -> s . sep . r) ss++hsList, hsLongList :: [ShowS] -> ShowS+hsList ss = hsBrackets $ unwordsByS (showChar ',') ss+hsLongList ss = hsBrackets $ unwordsByS (showString "\n\n,") ss++hsConstructor :: String -> [ShowS] -> ShowS+hsConstructor c ss =+ hsParens $ showString c+ . showChar ' '+ . unwordsByS (showChar ' ') ss++instance HsShow String where hsShows = shows+instance HsShow Bool where hsShows = shows+instance HsShow Int where hsShows = shows+instance HsShow Integer where hsShows = shows++instance HsShow Ptype where hsShows = shows+instance HsShow GType where hsShows = shows++-- | :-( I wish I could make do this with a default, overridable instance instead+-- basically, i would like to use hsList everywhere unless there is a specific+-- instance declaration, like one for String+instance HsShow a => HsShow [a] where+ hsShows xs = hsList (map hsShows xs)++instance (HsShow a, HsShow b) => HsShow (a,b) where+ hsShows (a,b) = hsParens $ (hsShows a) . (showChar ',') . (hsShows b)++instance (HsShow a, HsShow b, HsShow c) => HsShow (a,b,c) where+ hsShows (a,b,c) = hsParens $ (hsShows a) . (showChar ',') . (hsShows b) . (showChar ',') . (hsShows c)++instance (HsShow a) => HsShow (Tree a) where+ hsShows (Node a k) = hsConstructor "Node" [hsShows a, hsShows k]++-- | Note that you'll need to @import qualified Data.Map@+instance (HsShow a, HsShow b) => HsShow (Data.Map.Map a b) where+ hsShows m | Data.Map.null m = showString "Data.Map.empty"+ hsShows m = hsParens $ (showString "Data.Map.fromList ")+ . (hsShows (Data.Map.toList m))++instance HsShow a => HsShow (Maybe a) where+ hsShows Nothing = showString "Nothing"+ hsShows (Just x) = hsConstructor "Just" [hsShows x]++instance HsShow GeniVal where+ hsShows (GConst xs) = hsConstructor "GConst" [hsShows xs]+ hsShows (GVar xs) = hsConstructor "GVar" [hsShows xs]+ hsShows GAnon = showString "GAnon"++instance HsShow GNode where+ hsShows (GN a b c d e f g h) =+ hsConstructor "GN"+ [ hsShows a, hsShows b, hsShows c, hsShows d+ , hsShows e, hsShows f, hsShows g, hsShows h]++instance HsShow TagElem where+ hsShows (TE a b c d e f g h i j) =+ hsConstructor "TE"+ [ hsShows a, hsShows b, hsShows c, hsShows d+ , hsShows e, hsShows f, hsShows g, hsShows h+ , hsShows i, hsShows j]++instance HsShow f => HsShow (Ttree f) where+ hsShows (TT a b c d e f g h) = hsConstructor "TT"+ [ hsShows a, hsShows b, hsShows c, hsShows d+ , hsShows e, hsShows f, hsShows g, hsShows h]+\end{code}
+ Setup.lhs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ geniconvert.cabal view
@@ -0,0 +1,19 @@+Name: geniconvert+Version: 0.15+License: GPL+License-file: LICENSE+Author: Carlos Areces and Eric Kow+Build-Depends: libGenI >=0.14, base, binary, haskell98, containers, mtl, parsec, QuickCheck, HUnit, HaXml >=1.16+build-type: Simple+Category: Natural Language Processing+Homepage: http://wiki.loria.fr/wiki/GenI+Description: Conversion utility for the GenI generator+Synopsis: Conversion utility for the GenI generator+Maintainer: eric.kow@loria.fr+extra-source-files: NLP/GenI/HsShow.lhs, NLP/GenI/Converter/ReadTagml.hs, NLP/GenI/Converter/XmgTagml.hs+data-files: geniconvert.cabal++Executable: geniconvert+Main-Is: Converter.hs+Extensions: CPP, Rank2Types, OverlappingInstances, TypeSynonymInstances+Ghc-options: -Wall -O2