diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2008, University of Brighton
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in
+ the documentation and/or other materials provided with the
+ distribution.
+ * Neither the name of the University of Brighton nor the names of
+ its contributors may be used to endorse or promote products
+ derived from this software without specific prior written
+ permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/NLP/GizaPlusPlus.hs b/NLP/GizaPlusPlus.hs
new file mode 100644
--- /dev/null
+++ b/NLP/GizaPlusPlus.hs
@@ -0,0 +1,172 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -Wall #-}
+module NLP.GizaPlusPlus where
+
+import Control.Arrow ((&&&),(***))
+import Control.Exception (bracket)
+import Data.List (group, sort, intersperse)
+import qualified Data.Map as Map
+import System.Directory (removeFile, getTemporaryDirectory, createDirectoryIfMissing)
+import System.FilePath ((),(<.>))
+import System.IO (openBinaryFile, IOMode(WriteMode), openTempFile, Handle)
+import System.Process (runProcess, waitForProcess)
+
+import Text.ParserCombinators.Parsec (parseFromFile)
+
+import NLP.GizaPlusPlus.Parsec (alignFile)
+
+data WordPos = WordPos String Int deriving (Show,Eq,Ord)
+data Align = Align WordPos WordPos deriving (Show,Eq,Ord)
+
+-- ----------------------------------------------------------------------
+-- GIZA++ configuration
+-- ----------------------------------------------------------------------
+
+data GizaCfg = GizaCfg
+ { gizaHmmiterations :: Int
+ , gizaModel1iterations :: Int
+ , gizaModel2iterations :: Int
+ , gizaModel3iterations :: Int
+ , gizaModel4iterations :: Int
+ , gizaModel5iterations :: Int
+ , gizaPegging :: Bool
+ , gizaNBestAlignments :: Bool
+ , gizaCompactTable :: Bool
+ , gizaVerbose :: Bool
+ }
+
+defaultGizaCfg :: GizaCfg
+defaultGizaCfg = GizaCfg
+ { gizaHmmiterations = 0
+ , gizaModel1iterations = 5
+ , gizaModel2iterations = 5
+ , gizaModel3iterations = 3
+ , gizaModel4iterations = 3
+ , gizaModel5iterations = 3
+ , gizaPegging = True
+ , gizaNBestAlignments = True
+ , gizaCompactTable = False
+ , gizaVerbose = False
+ }
+
+-- | Convert a 'GizaCfg' into a (fragment of a) GIZA++ configuration
+-- file (when we call giza, we will append other entries)
+fromGizaCfg :: GizaCfg -> String
+fromGizaCfg gz =
+ concat . intersperse "\n" $
+ [ iEntry "hmmiterations " gizaHmmiterations
+ , iEntry "model1iterations" gizaModel1iterations
+ , iEntry "model2iterations" gizaModel2iterations
+ , iEntry "model3iterations" gizaModel3iterations
+ , iEntry "model4iterations" gizaModel4iterations
+ , iEntry "model5iterations" gizaModel5iterations
+ , bEntry "pegging" gizaPegging
+ , bEntry "nbestalignments" gizaNBestAlignments
+ , bEntry "compactadtable" gizaCompactTable ]
+ where
+ iEntry k f = k ++ " " ++ (show $ f gz)
+ bEntry k f = k ++ " " ++ (if f gz then "1" else "0")
+
+-- ----------------------------------------------------------------------
+-- running GIZA++
+-- ----------------------------------------------------------------------
+
+type Alignment = ([String],[String],[Align])
+
+-- | Run GIZA++ and extract a list of word alignments
+align :: GizaCfg
+ -> [(String,String)] -- ^ aligned sentence pairs
+ -> IO [Alignment]
+align gzcfg spairs =
+ do tmpDir <- getTemporaryDirectory
+ withTmp tmpDir $ \(cfg, _) -> do
+ -- write giza input and configuration files
+ let subTmpDir = tmpDir cfg ++ "-dir"
+ v1 = subTmpDir "source" <.> "vcb"
+ v2 = subTmpDir "target" <.> "vcb"
+ snt = subTmpDir "corpus" <.> "snt"
+ realcfg = subTmpDir "config"
+ createDirectoryIfMissing False subTmpDir
+ writeVcb v1 idx1
+ writeVcb v2 idx2
+ writeSnt snt wspairs
+ writeFile realcfg . unlines $
+ fromGizaCfg gzcfg : [ "s " ++ v1
+ , "t " ++ v2
+ , "c " ++ snt
+ , "o " ++ "output"
+ , "outputpath " ++ subTmpDir ]
+ -- go!
+ gizaStdout <- if gizaVerbose gzcfg
+ then return Nothing
+ else Just `fmap` openBinaryFile _dev_null WriteMode
+ proc <- runProcess "GIZA++" [realcfg] Nothing Nothing
+ Nothing -- stdin
+ gizaStdout -- stdout
+ gizaStdout -- stderr
+ waitForProcess proc
+ -- parse the output
+ let algnfile = subTmpDir "output.A3.final"
+ mparse <- parseFromFile alignFile algnfile
+ case mparse of
+ Left err -> fail $ "Error parsing GIZA++ output:\n" ++ show err
+ Right ps -> return $ map toAlignment ps
+ where
+ wspairs = map (words *** words) $ spairs
+ -- we start from 2 because GIZA++ uses denotes sentence boundaries with 1
+ countAndIdx :: [[String]] -> [(Int,(String,Int))]
+ countAndIdx = zip [2..] . count . concat
+ (idx1,idx2) = (countAndIdx *** countAndIdx) . unzip $ wspairs
+ --
+ writeVcb f = writeFile f . unlines . map toVcb
+ toVcb (i,(w,c)) = unwords [ show i, w, show c ]
+ --
+ writeSnt f = writeFile f . unlines . concatMap toSnt
+ toSnt (s1,s2) = ["1", toSntLine wi_map1 s1
+ , toSntLine wi_map2 s2 ]
+ toSntLine m = unwords . map (show . (m Map.!))
+ getWordIdx (i,(w,_)) = (w,i)
+ toWordIdxMap = Map.fromList . map getWordIdx
+ wi_map1 = toWordIdxMap idx1
+ wi_map2 = toWordIdxMap idx2
+ --
+ withTmp d = withTempFile d "hs-gizapp"
+
+_dev_null :: FilePath
+#ifdef WIN32
+_dev_null = "NUL"
+#else
+_dev_null = "/dev/null"
+#endif
+
+-- ----------------------------------------------------------------------
+-- parsing GIZA++ alignments
+-- ----------------------------------------------------------------------
+
+type OneToManyPair = (String, [Integer])
+
+-- by our use of Map.! we assume that the indices in the OneToManyPair
+-- actually correspond to the [String]
+toAlignment :: ([String], [OneToManyPair]) -> Alignment
+toAlignment (ts,pairs_) = (ss,ts,alignments)
+ where
+ pairs = drop 1 pairs_ -- NULL
+ ss = map fst pairs
+ alignments = concat $ zipWith alignment [0::Int ..] pairs
+ alignment si (s,tis) =
+ let f ti = Align (WordPos s (fromIntegral si))
+ (WordPos (tmap Map.! ti) (fromIntegral ti))
+ offset ti = ti - 1
+ in map (f . offset) tis
+ tmap :: Map.Map Integer String
+ tmap = Map.fromList $ zip [0..] $ ts
+
+-- ----------------------------------------------------------------------
+-- odds and ends
+-- ----------------------------------------------------------------------
+
+count :: Ord a => [a] -> [(a,Int)]
+count = map (head &&& length) . group . sort
+
+withTempFile :: FilePath -> String -> ((FilePath, Handle) -> IO a) -> IO a
+withTempFile d t = bracket (openTempFile d t) (removeFile . fst)
diff --git a/NLP/GizaPlusPlus/Parsec.hs b/NLP/GizaPlusPlus/Parsec.hs
new file mode 100644
--- /dev/null
+++ b/NLP/GizaPlusPlus/Parsec.hs
@@ -0,0 +1,50 @@
+module NLP.GizaPlusPlus.Parsec where
+
+import Text.ParserCombinators.Parsec
+import Text.ParserCombinators.Parsec.Language
+
+type OneToManyPair = (String, [Integer])
+
+alignFile :: CharParser () [([String], [OneToManyPair])]
+alignFile = manyTill alignSentencePair eof
+
+alignSentencePair :: CharParser () ([String], [OneToManyPair])
+alignSentencePair =
+ do char '#'; manyTill (noneOf "\n") (char '\n')
+ target <- sepEndBy alignWord justSpace
+ char '\n'
+ alignment <- sepEndBy alignWordPair justSpace
+ char '\n'
+ return (target, alignment)
+
+alignWordPair :: CharParser () OneToManyPair
+alignWordPair =
+ do wordFrom <- alignWord
+ justSpace
+ indicesTo <- between lbrack rbrack
+ $ do justSpace
+ option [] $ sepEndBy1 natural justSpace
+ return (wordFrom, indicesTo)
+ where
+ lbrack = string "({"
+ rbrack = string "})"
+
+alignWord :: CharParser () String
+alignWord = many1 alignChar
+
+alignChar :: CharParser () Char
+alignChar =
+ noneOf " \n\t}"
+ <|> (try $ do { c <- char '}'; notFollowedBy (char ')'); return c })
+
+justSpace :: CharParser () Char
+justSpace = char ' '
+
+natural :: CharParser () Integer
+natural = many digit >>= readM
+
+-- suggested by John Meacham on the haskell libraries list
+readM :: (Monad m,Read a) => String -> m a
+readM s = case reads s of
+ [(x, "")] -> return x
+ _ -> fail "readM: no parse"
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/hs-gizapp.cabal b/hs-gizapp.cabal
new file mode 100644
--- /dev/null
+++ b/hs-gizapp.cabal
@@ -0,0 +1,32 @@
+name: hs-gizapp
+version: 0.1.0.1
+synopsis: Haskell wrapper around the GIZA++ toolkit.
+description: This provides a simple wrapper around the GIZA++ toolkit,
+ which is used for Statistical Machine Translation for
+ training IBM Models 1-5 and an HMM word alignment model.
+ See for more details on
+ GIZA++
+ .
+ This work was made possible by EPSRC grant (EP\/E029116\/1)
+ .
+ darcs get
+ .
+ Note that while this wrapper is BSD3 licensed, GIZA++
+ itself is released under GPLv2.
+ .
+category: Natural Language Processing
+license: BSD3
+license-file: LICENSE
+author: Eric Kow
+maintainer:
+build-Depends: base >= 3 && < 4,
+ containers >= 0.1 && < 0.3,
+ directory >= 1.0 && < 1.1,
+ filepath >= 1.1 && < 1.2,
+ parsec >= 2.1 && < 3.1,
+ process >= 1.0 && < 1.1
+build-Type: Simple
+ghc-options:
+cabal-version: >= 1.2
+
+Exposed-modules: NLP.GizaPlusPlus