diff --git a/Converter.hs b/Converter.hs --- a/Converter.hs +++ b/Converter.hs @@ -28,9 +28,9 @@ 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 Prelude hiding (appendFile, getContents, readFile, writeFile, putStrLn) +import System.IO.UTF8 import NLP.GenI.Btypes import NLP.GenI.BtypesBinary () @@ -40,16 +40,21 @@ import NLP.GenI.HsShow (hsShow) import NLP.GenI.Converter.ReadTagml (readTagmlMacros) +import Paths_geniconvert +import Data.Version + main :: IO () main = do args <- getArgs progname <- getProgName case getOpt Permute options args of + (o,_, [] ) | VersionFlg `elem` o -> + do putStrLn $ "geniconvert version " ++ showVersion version (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" + let header = "usage: " ++ p ++ " [--macros|--lexicon] -f [tagml|geni] -t [haskell|geni|genib] -o output < input" ePutStrLn $ usageInfo header options exitWith (ExitFailure 1) @@ -76,11 +81,9 @@ 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) @@ -90,7 +93,7 @@ -- ------------------------------------------------------------------- data Flag = FromFlg String | ToFlg String | OutputFlg String - | MacrosFlg | LexiconFlg | MorphLexiconFlg + | MacrosFlg | LexiconFlg | VersionFlg deriving (Eq) options :: [OptDescr Flag] @@ -98,18 +101,17 @@ [ 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 "v" ["version"] (NoArg VersionFlg) "display version" +-- , 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 +data InputType = MacrosItype | LexiconItype instance Show InputType where show MacrosItype = "macros" show LexiconItype = "lexicons" - show MorphLexiconItype = "morphological lexicons" data InputParams = InputParams { fromArg :: String , toArg :: String @@ -129,7 +131,7 @@ 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 } +processFlag VersionFlg = id -- ------------------------------------------------------------------- -- formats @@ -149,10 +151,6 @@ , 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 @@ -184,15 +182,10 @@ , 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 @@ -209,15 +202,10 @@ , 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 @@ -237,10 +225,6 @@ , parseLexicon = Nothing , readLexicon = Just decodeFile , writeLexicon = Just encodeFile - -- - , parseMorphLexicon = Nothing - , readMorphLexicon = Just decodeFile - , writeMorphLexicon = Just encodeFile } -- ------------------------------------------------------------------- @@ -258,10 +242,6 @@ , parseLexicon = Nothing , readLexicon = Nothing , writeLexicon = Nothing - -- - , parseMorphLexicon = Nothing - , readMorphLexicon = Nothing - , writeMorphLexicon = Nothing } writeHaskellMacros :: String -> Macros -> IO () diff --git a/NLP/GenI/Converter/ReadTagml.hs b/NLP/GenI/Converter/ReadTagml.hs --- a/NLP/GenI/Converter/ReadTagml.hs +++ b/NLP/GenI/Converter/ReadTagml.hs @@ -28,7 +28,7 @@ import Text.XML.HaXml.Posn (posInNewCxt) import NLP.GenI.Btypes - ( AvPair, Flist + ( AvPair(..), Flist , GType(Subs,Foot,Lex,Other) , GNode(..), Macros, Ttree(..) , GeniVal(GConst, GVar, GAnon), fromGConst, lexemeAttributes @@ -142,7 +142,7 @@ 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 ]) + lexL = concat $ map (\la -> [ v | AvPair a v <- gloF, a == la ]) lexemeAttributes lexeme = case (ntype,lexL) of (Lex,h:_) -> fromGConst h @@ -200,8 +200,8 @@ 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)) [] +translateF (X.FSym attr s) = Node (Right $ AvPair (X.fName attr) (translateSym s)) [] +translateF (X.FVAlt attr d) = Node (Right $ AvPair (X.fName attr) (translateVAlt d)) [] flattenFs :: Tree FsTreeNode -> [AvPair] flattenFs = catMaybes . (map fromRight) . flatten @@ -213,8 +213,8 @@ 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) +translateFlatF (X.FSym attr s) = AvPair (X.fName attr) (translateSym s) +translateFlatF (X.FVAlt attr d) = AvPair (X.fName attr) (translateVAlt d) translateSym :: X.Sym -> GeniVal translateSym s = diff --git a/NLP/GenI/HsShow.hs b/NLP/GenI/HsShow.hs new file mode 100644 --- /dev/null +++ b/NLP/GenI/HsShow.hs @@ -0,0 +1,121 @@ +-- 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. + +{- +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 go a lot faster. +-} + +{-# LANGUAGE TypeSynonymInstances #-} +module NLP.GenI.HsShow +where + +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(..), AvPair(..) + ) +import NLP.GenI.PolarityTypes ( PolarityKey(..) ) + +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 +instance HsShow PolarityKey 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 AvPair where + hsShows (AvPair a v) = hsConstructor "AvPair" [ hsShows a, hsShows v ] + +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] diff --git a/NLP/GenI/HsShow.lhs b/NLP/GenI/HsShow.lhs deleted file mode 100644 --- a/NLP/GenI/HsShow.lhs +++ /dev/null @@ -1,124 +0,0 @@ -% 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} diff --git a/geniconvert.cabal b/geniconvert.cabal --- a/geniconvert.cabal +++ b/geniconvert.cabal @@ -1,17 +1,20 @@ Name: geniconvert -Version: 0.17.1 +Version: 0.20 License: GPL License-file: LICENSE Author: Carlos Areces and Eric Kow -Build-Depends: GenI >=0.17.2 && < 0.18, base < 4, binary, haskell98, containers, mtl, parsec - < 3, QuickCheck, HUnit, HaXml >=1.16 +Build-Depends: GenI >=0.20 && < 0.21 + , base < 4.1 + , binary, haskell98, containers, mtl + , parsec < 3, QuickCheck, HUnit, HaXml >=1.16 + , utf8-string >= 0.3.5 && < 0.4 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 +Maintainer: geni-users@loria.fr +extra-source-files: NLP/GenI/HsShow.hs, NLP/GenI/Converter/ReadTagml.hs, NLP/GenI/Converter/XmgTagml.hs data-files: geniconvert.cabal Executable: geniconvert