Encode 1.2 → 1.3.1
raw patch · 9 files changed
+355/−281 lines, 9 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Encode: version :: Version
Files
- Encode.cabal +3/−3
- Encode.hs +14/−8
- Encode/Arabic.hs +3/−3
- Encode/Arabic/ArabTeX.hs +141/−123
- Encode/Arabic/ArabTeX/ZDMG.hs +149/−90
- Encode/Mapper.hs +6/−17
- Encode/Unicode.hs +3/−3
- Exec/Decode/Main.hs +18/−17
- Exec/Encode/Main.hs +18/−17
Encode.cabal view
@@ -1,15 +1,15 @@ name: Encode -version: 1.2 +version: 1.3.1 license: GPL license-file: LICENSE extra-source-files: INSTALL, LicenseBSD, LicenseGPL, Setup.PL -copyright: 2009 +copyright: 2010 author: Otakar Smrz maintainer: otakar.smrz mff.cuni.cz homepage: http://ufal.mff.cuni.cz/~smrz/ package-url: http://sourceforge.net/projects/encode-arabic/ category: Text, Codec -build-depends: Cabal, base, mtl +build-depends: Cabal, base <= 4.2, mtl build-type: Simple synopsis: Encoding character data description: The "Encode" library provides a unified interface for
Encode.hs view
@@ -1,11 +1,11 @@ -- -------------------------------------------------------------------------- --- $Revision: 808 $ $Date: 2009-02-10 00:19:07 +0100 (Tue, 10 Feb 2009) $ +-- $Revision: 935 $ $Date: 2010-02-13 18:23:52 +0100 (Sat, 13 Feb 2010) $ -- -------------------------------------------------------------------------- -- | -- -- Module : Encode --- Copyright : Otakar Smrz 2005-2009 +-- Copyright : Otakar Smrz 2005-2010 -- License : BSD-style -- -- Maintainer : otakar.smrz mff.cuni.cz @@ -30,18 +30,24 @@ -- * Methods - encode, decode + encode, decode, + -- * Version + + version + ) where import Data.Word - + import Version -version = revised "$Revision: 808 $" +version = Version [1, 3, min build 1] [] + where Version [build] [] = revised "$Revision: 935 $" + -- | The datatype introduced for the internal representation of Unicode code -- points is currently defined as @newtype 'UPoint' = UPoint CSpace@. The -- shift to code points @UPoint@ from characters @Char@ is intentional, as @@ -59,11 +65,11 @@ deriving (Eq, Ord) - + -- | The 'CSpace' type denotes the code space, and it is a synonym to 'Word'. - + type CSpace = Word - + -- | Encodings are represented as distinct datatypes of the 'Encoding' class, -- which defines two essential methods:
Encode/Arabic.hs view
@@ -1,11 +1,11 @@ -- -------------------------------------------------------------------------- --- $Revision: 808 $ $Date: 2009-02-10 00:19:07 +0100 (Tue, 10 Feb 2009) $ +-- $Revision: 931 $ $Date: 2010-01-24 22:32:37 +0100 (Sun, 24 Jan 2010) $ -- -------------------------------------------------------------------------- -- | -- -- Module : Encode.Arabic --- Copyright : Otakar Smrz 2005-2009 +-- Copyright : Otakar Smrz 2005-2010 -- License : GPL -- -- Maintainer : otakar.smrz mff.cuni.cz @@ -45,4 +45,4 @@ import Version -version = revised "$Revision: 808 $" +version = Encode.version
Encode/Arabic/ArabTeX.hs view
@@ -1,11 +1,11 @@ -- -------------------------------------------------------------------------- --- $Revision: 582 $ $Date: 2008-06-20 00:41:41 +0200 (Fri, 20 Jun 2008) $ +-- $Revision: 934 $ $Date: 2010-02-13 17:26:58 +0100 (Sat, 13 Feb 2010) $ -- -------------------------------------------------------------------------- -- | -- -- Module : Encode.Arabic.ArabTeX --- Copyright : Otakar Smrz 2005-2008 +-- Copyright : Otakar Smrz 2005-2010 -- License : GPL -- -- Maintainer : otakar.smrz mff.cuni.cz @@ -41,7 +41,7 @@ import Version -version = revised "$Revision: 582 $" +version = revised "$Revision: 934 $" data ArabTeX = ArabTeX | Lagally | TeX @@ -216,11 +216,10 @@ <|> parseInitVowel <|> parseWhite - <|> parsePunct + <|> parsePunct <|> parseDigit - <|> parseQuote <|> parseControl <|> parseAnything @@ -236,6 +235,7 @@ parseAnything :: Parsing parseAnything = do x <- sat (const True) + resetEnv setWasla False return ((++) (map (toEnum . fromEnum) x)) @@ -243,29 +243,43 @@ parseNothing = return id -parseQuote = do lower ["\\\""] [] +parseQuote = do lower ["\""] [] processControl "\"" - {- - do i <- inspectInps - case i of - "\\\"" : s -> processControl "\"" s - _ -> zero - parseNothing - -} - parseControl = do i <- inspectIList case i of - [] -> zero - (c : s) -> case c of - '\\' : t : r -> do returnIList s - processControl (t : r) - "\\" -> fail "Single \\" - _ -> zero + (r : s) -> case r of + "\"" -> do returnIList s + processControl r + '\\' : t -> do returnIList s + return ((++) (map (toEnum . fromEnum) r)) + + '\NUL' : t -> do returnIList s + processControl t + + [c] | c `elem` ['<', '>'] + + -> do returnIList v + return ((++) [(toEnum . fromEnum) y | x <- r : p ++ u, y <- x ]) + + where (p, q) = break (`elem` ["<", ">"]) s + (u, v) = splitAt 1 q + + [c] | c `elem` ['{', '}'] + + -> do returnIList s + processControl r + return ((++) (map (toEnum . fromEnum) r)) + + _ -> zero + + [] -> zero + + processControl :: [Char] -> Parsing processControl t = do e <- inspectEList @@ -276,27 +290,20 @@ "{" -> q : q : r "}" -> case r of - [] -> error "Minus group" + [] -> q : r _ -> r "\"" -> setQuote True q : r - "cap" -> setQuote True q : r "fullvocalize" -> setMode Fullvocalize q : r - "full" -> setMode Fullvocalize q : r "vocalize" -> setMode Vocalize q : r - "nosukuun" -> setMode Vocalize q : r "novocalize" -> setMode Novocalize q : r - "novowels" -> setMode Novocalize q : r - "none" -> setMode Novocalize q : r - "noshadda" -> setMode Nodiacritics q : r - "noneplus" -> setMode Nodiacritics q : r "nodiacritics" -> setMode Nodiacritics q : r "setverb" -> setVerb True q : r "setarab" -> setVerb False q : r - _ -> error "Weird control sequence" + _ -> q : r returnEList envList parseNothing @@ -391,10 +398,9 @@ return carryHamza - where prospectCarrier = do parseQuote + where prospectCarrier = do lower ["\""] [] b <- lookaheadCarrier - lower [] ["\\\""] - resetEnv setQuote False + lower [] ["\""] return b <|> lookaheadCarrier @@ -499,26 +505,25 @@ -- x <- upper ["W"] [silent] -- depends on 'vowelControl' y <- upperWith (vowelControl "W") [v] [vowel, multi, nuuns, other] - completeSyllable ["W", v] y + completeSyllable y ["W", v] parseSyllVowel :: [Char] -> ([UPoint] -> [UPoint]) -> Parsing ---parseSyllVowel :: [Char] -> [UPoint] -> Parsing parseSyllVowel c x = do v <- parseQuote <|> parseNothing >> oneof' '-' [vowel, multi, nuuns, other] <|> oneof [vowel, multi, nuuns, other] <|> return "" y <- upperWith (vowelControl c) [v] [vowel, multi, nuuns, other, sukun] - completeSyllable [c, v] (x `plus` y) + completeSyllable (x `plus` y) [c, v] -completeSyllable :: [[Char]] -> ([UPoint] -> [UPoint]) -> Parsing -completeSyllable l u = +completeSyllable :: ([UPoint] -> [UPoint]) -> [[Char]] -> Parsing +completeSyllable x y = do resetEnv setQuote False resetEnv setWasla True - resetEnv setEarly (reverse l) - return u + resetEnv setEarly (reverse y) + return x parseSingleCons = @@ -532,14 +537,21 @@ lower [c] [] x <- upper [c] [sunny, moony, bound, taaaa, invis, silent] y <- upperWith shaddaControl - ["*"] [shadda] + [""] [shadda] parseSyllVowel c (x `plus` y) parseHyphen = + do lower ["-", "-"] [] + upper ["B"] [moony] + <|> do lower ["-"] [] resetEnv setEarly [] parseNothing + <|> + do oneof' '-' [vowel, multi, nuuns, other] + resetEnv setEarly [] + parseNothing parseDefinite = @@ -547,33 +559,7 @@ lower ["-", c] [c, c] upper ["l"] [sunny] - {- - do c <- oneof [sunny, moony, bound] - lower ["-", c] - x <- upper ["l", c] [sunny, moony, bound] - y <- upper ["*"] [shadda] - return (x ++ y) - -} - {- - anyof [ - do lower [cl, cl] - do do lower [sl] <+> lower [] - upper [cr, sr] - <+> - do lower [vl] - upper [cr, dr, vr] - - | (cl,cr) <- sunny ++ moony, (vl,vr) <- short, - (sl,sr) <- sukun, (dl,dr) <- sadda ] - -} - - -parseDigit = - do d <- oneof [digit] - upper [d] [digit] - - parseWhite = do w <- oneof [white] resetEnv setEarly [] @@ -583,9 +569,17 @@ parsePunct = do p <- oneof [punct] resetEnv setWasla False + resetEnv setEarly [] upper [p] [punct] +parseDigit = + do d <- oneof [digit] + resetEnv setWasla False + resetEnv setEarly [] + upper [d] [digit] + + -- -------------------------------------------------------------------------- -- Mapping Definitions -- -------------------------------------------------------------------------- @@ -607,15 +601,15 @@ decoderMapping :: Mapper Char (Quit Char [[Char]]) decoderMapping = defineMapping - ( pairs [ sunny, moony, invis, empty, taaaa, silent, - vowel, multi, nuuns, other, sukun, shadda, - -- white, + ( pairs [ sunny, moony, invis, taaaa, silent, + vowel, multi, nuuns, other, + -- empty, white, sukun, shadda, digit, punct ] ) <+> rules `others` (\ s -> (Just . return) ([], [[s]])) --- <+> "" |.| error "Illegal symbol" + -- <+> "" |.| error "Illegal symbol" defineMapping :: [([Char], [a])] -> Mapping @@ -628,15 +622,14 @@ symbols = fmap (((,) []) . (: [])) . syms -whites :: Mapper Char (Quit Char Char) - -whites = (fmap ((,) []) . anySymbol) [' ', '\r', '\v', '\f'] - -- [' ', '\n', '\r', '\t', '\v', '\f'] +rules :: Mapping +rules = -rules :: Mapping + "+" |.| [] |+| + "*" |.| [] |+| -rules = rulePunctuation + "_W" |-| "w" |:| [] |+| ruleVerbalSilentAlif |+| ruleMaqsuuraWithAlif @@ -650,18 +643,11 @@ |+| ruleMultiVowel |+| ruleHyphenedVowel - |+| ruleWhitePlusControl - |+| ruleIgnoreCapControl + |+| ruleGroupControl + |+| ruleCapsControl |+| ruleControlSequence -rulePunctuation = - - "-" |.| ["-"] |+| - "\"" |.| ["\\\""] |+| - "\\\"" |.| ["\""] - - ruleVerbalSilentAlif = "aWA" |-| "awW" |:| [] |+| @@ -685,30 +671,33 @@ "_A" |-| "Y" |:| [] -ruleWhitePlusControl = +ruleGroupControl = - "{" |.| ["\\{"] |+| - "}" |.| ["\\}"] |+| + "\NUL" |.| [] - "\\{" |.| ["{"] |+| - "\\}" |.| ["}"] |+| + <+> + do syms "\NUL" - "\\\\" |.| ["\\\\"] |+| - "\\" |.| ["\\"] + ">" |.| [">"] |+| "<" |.| ["<"] - <+> sym '\\' <.> some whites <-> [" "] + `others` (\ s -> (Just . return) ("\NUL", [[s]])) + <+> + do syms "<" - <+> some whites <-> [" "] + ">" |.| ["<", ">"] + `others` (\ s -> (Just . return) ("\NUL", ["<", [s]])) + <+> + do syms ">" -ruleIgnoreCapControl = + "<" |.| [">", "<"] - do syms "\\cap" - many whites - return ([], []) + `others` (\ s -> (Just . return) ("\NUL", [">", [s]])) - |+| anyof [ +ruleCapsControl = + + anyof [ "l" ++ v ++ "-a" ++ c ++ "-" ++ "\\cap " |-| "l" ++ v ++ "-a" ++ c ++ "-" ++ "\\cap " |:| [] |+| @@ -718,7 +707,6 @@ | c <- elems [sunny, moony], v <- elems [vowel, sukun] ++ quote [vowel, sukun] ] - |+| anyof [ "l" ++ "-" ++ c ++ "\\cap " |-| @@ -738,18 +726,47 @@ ruleControlSequence = - do x <- sym '\\' <:> - some (anySymbol (['A'..'Z'] ++ ['a'..'z'])) - many whites - return ([], [x]) + "\\<" |.| ["\\<"] |+| + "\\>" |.| ["\\>"] |+| - {- - fmap (:[]) (fmap (++) ( sym '\\' - <:> some (anySymbol (['A'..'Z'] ++ ['a'..'z'])) ) - <*> many white <-> "") - -} + "\\{" |.| ["\\{"] |+| + "\\}" |.| ["\\}"] |+| + "\\\"" |.| ["\\\""] |+| + "\\\\" |.| ["\\\\"] + + <+> + do sym '\\' + x <- some (anySymbol (['A'..'Z'] ++ ['a'..'z'])) + y <- many (sym ' ') + let s = case x of + + "cap" -> ([], ['\NUL' : x]) + + "fullvocalize" -> ([], ['\NUL' : x]) + "vocalize" -> ([], ['\NUL' : x]) + "novocalize" -> ([], ['\NUL' : x]) + "nodiacritics" -> ([], ['\NUL' : x]) + + "full" -> ([], ['\NUL' : "fullvocalize"]) + + "nosukuun" -> ([], ['\NUL' : "vocalize"]) + + "novowels" -> ([], ['\NUL' : "novocalize"]) + "none" -> ([], ['\NUL' : "novocalize"]) + + "noshadda" -> ([], ['\NUL' : "nodiacritics"]) + "noneplus" -> ([], ['\NUL' : "nodiacritics"]) + + "setverb" -> ([], ['\NUL' : x]) + "setarab" -> ([], ['\NUL' : x]) + + _ -> (y, ['\\' : x]) + + return s + + ruleLiWithDefinite = anyof [ @@ -860,7 +877,7 @@ anyof [ "-" ++ v |.| ["-" ++ v] |+| - -- "-\"" ++ v |.| ["\\\"", "-" ++ v] |+| + -- "-\"" ++ v |.| ["\"", "-" ++ v] |+| "-\"" ++ v |-| "\"-" ++ v |:| [] |+| @@ -987,13 +1004,14 @@ sukun = define [ - ( "", [ 0x0652 ] ), - ( "+", [ 0x0652 ] ) + ( "", [ 0x0652 ] ) + -- ( "+", [ 0x0652 ] ) ] shadda = define [ - ( "*", [ 0x0651 ] ) + ( "", [ 0x0651 ] ) + -- ( "*", [ 0x0651 ] ) ] @@ -1133,16 +1151,6 @@ ] -white = define [ - ( " ", [ 0x0020 ] ), - ( "\n", [ 0x000A ] ), - ( "\r", [ 0x000D ] ), - ( "\t", [ 0x0009 ] ), - ( "\v", [ 0x000B ] ), - ( "\f", [ 0x000C ] ) - ] - - punct = define [ -- ( ".", [ 0x002E ] ), -- ( ":", [ 0x003A ] ), @@ -1151,4 +1159,14 @@ ( ",", [ 0x060C ] ), ( ";", [ 0x061B ] ), ( "?", [ 0x061F ] ) + ] + + +white = define [ + ( " ", [ 0x0020 ] ), + ( "\n", [ 0x000A ] ), + ( "\r", [ 0x000D ] ), + ( "\t", [ 0x0009 ] ), + ( "\v", [ 0x000B ] ), + ( "\f", [ 0x000C ] ) ]
Encode/Arabic/ArabTeX/ZDMG.hs view
@@ -1,11 +1,11 @@ -- -------------------------------------------------------------------------- --- $Revision: 808 $ $Date: 2009-02-10 00:19:07 +0100 (Tue, 10 Feb 2009) $ +-- $Revision: 934 $ $Date: 2010-02-13 17:26:58 +0100 (Sat, 13 Feb 2010) $ -- -------------------------------------------------------------------------- -- | -- -- Module : Encode.Arabic.ArabTeX.ZDMG --- Copyright : Otakar Smrz 2005-2009 +-- Copyright : Otakar Smrz 2005-2010 -- License : GPL -- -- Maintainer : otakar.smrz mff.cuni.cz @@ -39,7 +39,7 @@ import Version -version = revised "$Revision: 808 $" +version = revised "$Revision: 934 $" data ZDMG = ZDMG | ArabTeX_ZDMG @@ -184,11 +184,10 @@ <|> parseInitVowel <|> parseWhite - <|> parsePunct - <|> parseDigit + -- <|> parsePunct + -- <|> parseDigit - <|> parseCap <|> parseControl <|> parseAnything @@ -204,6 +203,7 @@ parseAnything :: Parsing parseAnything = do x <- sat (const True) + resetEnv setWasla False return ((++) (map (toEnum . fromEnum) x)) @@ -211,22 +211,39 @@ parseNothing = return id -parseCap = - do lower ["\\cap"] [] - processControl "cap" - - parseControl = do i <- inspectIList case i of - [] -> zero - (c : s) -> case c of - '\\' : t : r -> do returnIList s - processControl (t : r) - "\\" -> fail "Single \\" - _ -> zero + (r : s) -> case r of + "\"" -> do returnIList s + processControl r + '\\' : t -> do returnIList s + return ((++) (map (toEnum . fromEnum) r)) + + '\NUL' : t -> do returnIList s + processControl t + + [c] | c `elem` ['<', '>'] + + -> do returnIList v + return ((++) [(toEnum . fromEnum) y | x <- r : p ++ u, y <- x ]) + + where (p, q) = break (`elem` ["<", ">"]) s + (u, v) = splitAt 1 q + + [c] | c `elem` ['{', '}'] + + -> do returnIList s + processControl r + return ((++) (map (toEnum . fromEnum) r)) + + _ -> zero + + [] -> zero + + processControl :: [Char] -> Parsing processControl t = do e <- inspectEList @@ -237,27 +254,21 @@ "{" -> q : q : r "}" -> case r of - [] -> error "Minus group" + [] -> q : r _ -> r "\"" -> setQuote True q : r "cap" -> setCap True q : r "fullvocalize" -> setMode Fullvocalize q : r - "full" -> setMode Fullvocalize q : r "vocalize" -> setMode Vocalize q : r - "nosukuun" -> setMode Vocalize q : r "novocalize" -> setMode Novocalize q : r - "novowels" -> setMode Novocalize q : r - "none" -> setMode Novocalize q : r - "noshadda" -> setMode Nodiacritics q : r - "noneplus" -> setMode Nodiacritics q : r "nodiacritics" -> setMode Nodiacritics q : r "setverb" -> setVerb True q : r "setarab" -> setVerb False q : r - _ -> error "Weird control sequence" + _ -> q : r returnEList envList parseNothing @@ -273,26 +284,31 @@ else do lower [] [c] y <- upperWith (vowelControl "W") [v] [vowel] - completeSyllable y + completeSyllable y True <|> do v <- oneof [vowel] y <- upperWith (vowelControl "W") [v] [vowel] - completeSyllable y + completeSyllable y True parseSyllVowel :: [Char] -> ([UPoint] -> [UPoint]) -> Parsing parseSyllVowel c x = - do v <- oneof [vowel] <|> return "" + do v <- oneof [vowel] y <- upperWith (vowelControl c) - [v] [vowel, sukun] - completeSyllable (x `plus` y) + [v] [vowel] + completeSyllable (x `plus` y) True + <|> + do v <- return "" -- oneof [sukun] + y <- upperWith (vowelControl c) + [v] [sukun] + completeSyllable (x `plus` y) False -completeSyllable :: ([UPoint] -> [UPoint]) -> Parsing -completeSyllable x = +completeSyllable :: ([UPoint] -> [UPoint]) -> Bool -> Parsing +completeSyllable x y = do resetEnv setQuote False - resetEnv setWasla True + resetEnv setWasla y resetEnv setCap False return x @@ -317,7 +333,7 @@ resetEnv setCap False y <- upperWith shaddaControl [c] [sunny, moony, extra, invis] - -- ["*"] [shadda] + -- [""] [shadda] parseSyllVowel c (x `plus` y) <|> do c <- oneof [minor] @@ -325,7 +341,7 @@ x <- upper [c] [minor] y <- upperWith shaddaControl [c] [minor] - -- ["*"] [shadda] + -- [""] [shadda] parseSyllVowel c (x `plus` y) @@ -334,22 +350,26 @@ upper ["-"] [hyphen] -parseDigit = - do d <- oneof [digit] - upper [d] [digit] - - parseWhite = do w <- oneof [white] + resetEnv setQuote False upper [w] [white] +{- parsePunct = do p <- oneof [punct] resetEnv setWasla False upper [p] [punct] +parseDigit = + do d <- oneof [digit] + resetEnv setWasla False + upper [d] [digit] +-} + + -- -------------------------------------------------------------------------- -- Mapping Definitions -- -------------------------------------------------------------------------- @@ -371,14 +391,14 @@ decoderMapping :: Mapper Char (Quit Char [[Char]]) decoderMapping = defineMapping - ( pairs [ sunny, moony, minor, extra, invis, empty, - -- digit, punct, white, + ( pairs [ sunny, moony, minor, extra, invis, + -- empty, white, digit, punct, vowel ] ) <+> rules `others` (\ s -> (Just . return) ([], [[s]])) --- <+> "" |.| error "Illegal symbol" + -- <+> "" |.| error "Illegal symbol" defineMapping :: [([Char], [a])] -> Mapping @@ -391,43 +411,30 @@ symbols = fmap (((,) []) . (: [])) . syms -whites :: Mapper Char (Quit Char Char) - -whites = (fmap ((,) []) . anySymbol) [' ', '\r', '\v', '\f'] - -- [' ', '\n', '\r', '\t', '\v', '\f'] - - rules :: Mapping rules = "N_A" |-| "NY" |:| [] |+| - "_A" |-| "Y" |:| [] + "_A" |-| "Y" |:| [] |+| + "_W" |.| [] + |+| ruleVerbalSilentAlif |+| ruleInternalTaaaa --- |+| ruleLiWithDefinite + -- |+| ruleLiWithDefinite |+| ruleDefinite |+| ruleIndefinite |+| ruleMultiVowel |+| ruleHyphenedVowel - |+| ruleWhitePlusControl - |+| ruleIgnoreCapControl + |+| ruleGroupControl + |+| ruleCapsControl |+| ruleControlSequence - |+| rulePunctuation - -rulePunctuation = - - "-" |.| ["-"] |+| - "\"" |.| ["\\\""] |+| - "\\\"" |.| ["\""] - - ruleVerbalSilentAlif = "aWA" |-| "aw" |:| [] |+| @@ -436,24 +443,32 @@ "uW" |-| "uw" |:| [] -ruleWhitePlusControl = +ruleGroupControl = - "{" |.| ["\\{"] |+| - "}" |.| ["\\}"] |+| + "\NUL" |.| [] - "\\{" |.| ["{"] |+| - "\\}" |.| ["}"] |+| + <+> + do syms "\NUL" - "\\\\" |.| ["\\\\"] |+| - "\\" |.| ["\\"] + ">" |.| [">"] |+| "<" |.| ["<"] - <+> sym '\\' <.> some whites <-> [" "] + `others` (\ s -> (Just . return) ("\NUL", [[s]])) + <+> + do syms "<" - <+> some whites <-> [" "] + ">" |.| ["<", ">"] + `others` (\ s -> (Just . return) ("\NUL", ["<", [s]])) + <+> + do syms ">" -ruleIgnoreCapControl = + "<" |.| [">", "<"] + `others` (\ s -> (Just . return) ("\NUL", [">", [s]])) + + +ruleCapsControl = + anyof [ "l" ++ "-" ++ c ++ "\\cap " |-| "l" ++ "-" ++ c ++ "\\cap " |:| [] |+| @@ -471,7 +486,7 @@ "l" ++ "-\\cap " ++ c ++ "\\cap " |:| [] |+| "l" ++ "-\\cap " ++ c ++ "\\cap " ++ c |-| - "-\\cap " ++ c |:| ["\\cap", c] |+| + "-\\cap " ++ c |:| ["\\cap", c] |+| "l" ++ "-\\cap " ++ c ++ c |-| "-\\cap " ++ c |:| [c] @@ -481,12 +496,47 @@ ruleControlSequence = - do x <- sym '\\' <:> - some (anySymbol (['A'..'Z'] ++ ['a'..'z'])) - many whites - return ([], [x]) + "\\<" |.| ["\\<"] |+| + "\\>" |.| ["\\>"] |+| + "\\{" |.| ["\\{"] |+| + "\\}" |.| ["\\}"] |+| + "\\\"" |.| ["\\\""] |+| + + "\\\\" |.| ["\\\\"] + + <+> + do sym '\\' + x <- some (anySymbol (['A'..'Z'] ++ ['a'..'z'])) + y <- many (sym ' ') + let s = case x of + + "cap" -> ([], ['\NUL' : x]) + + "fullvocalize" -> ([], ['\NUL' : x]) + "vocalize" -> ([], ['\NUL' : x]) + "novocalize" -> ([], ['\NUL' : x]) + "nodiacritics" -> ([], ['\NUL' : x]) + + "full" -> ([], ['\NUL' : "fullvocalize"]) + + "nosukuun" -> ([], ['\NUL' : "vocalize"]) + + "novowels" -> ([], ['\NUL' : "novocalize"]) + "none" -> ([], ['\NUL' : "novocalize"]) + + "noshadda" -> ([], ['\NUL' : "nodiacritics"]) + "noneplus" -> ([], ['\NUL' : "nodiacritics"]) + + "setverb" -> ([], ['\NUL' : x]) + "setarab" -> ([], ['\NUL' : x]) + + _ -> (y, ['\\' : x]) + + return s + + ruleLiWithDefinite = anyof [ @@ -550,7 +600,7 @@ ruleHyphenedVowel = anyof [ - "-" ++ v |-| v |:| [] |+| + "-" ++ v |-| v |:| ["-"] |+| "iy-" ++ v |-| "y-" ++ v |:| ["i", "|"] |+| "uw-" ++ v |-| "w-" ++ v |:| ["u", "|"] |+| @@ -561,8 +611,6 @@ |+| anyof [ - "-" ++ v ++ c |-| v ++ c |:| ["-"] |+| - -- "iy-" ++ v ++ c |-| "-" ++ v ++ c |:| ["I"] |+| -- "uw-" ++ v ++ c |-| "-" ++ v ++ c |:| ["U"] |+| @@ -647,14 +695,22 @@ sukun = define [ + ( "", [ ] ) + ] + + +{- +sukun = define [ ( "", [ ] ), ( "+", [ ] ) ] shadda = define [ + ( "", [ ] ), ( "*", [ ] ) ] +-} wasla = define [ @@ -669,6 +725,7 @@ ( "W", [ ] ) ] + {- hamza = define [ ( "'A", [ 0x0622 ] ), @@ -747,6 +804,7 @@ ] +{- digit = define [ ( "0", [ 0x0030 ] ), ( "1", [ 0x0031 ] ), @@ -761,16 +819,6 @@ ] -white = define [ - ( " ", [ 0x0020 ] ), - ( "\n", [ 0x000A ] ), - ( "\r", [ 0x000D ] ), - ( "\t", [ 0x0009 ] ), - ( "\v", [ 0x000B ] ), - ( "\f", [ 0x000C ] ) - ] - - punct = define [ ( ".", [ 0x002E ] ), ( ":", [ 0x003A ] ), @@ -779,4 +827,15 @@ ( ",", [ 0x002C ] ), ( ";", [ 0x003B ] ), ( "?", [ 0x003F ] ) + ] +-} + + +white = define [ + ( " ", [ 0x0020 ] ), + ( "\n", [ 0x000A ] ), + ( "\r", [ 0x000D ] ), + ( "\t", [ 0x0009 ] ), + ( "\v", [ 0x000B ] ), + ( "\f", [ 0x000C ] ) ]
Encode/Mapper.hs view
@@ -1,5 +1,5 @@ -- -------------------------------------------------------------------------- --- $Revision: 776 $ $Date: 2008-12-17 23:35:39 +0100 (Wed, 17 Dec 2008) $ +-- $Revision: 903 $ $Date: 2009-11-16 10:21:32 +0100 (Mon, 16 Nov 2009) $ -- -------------------------------------------------------------------------- -- | @@ -55,26 +55,12 @@ import PureFP.OrdMap ---import Data.Map (Map) ---import qualified Data.Map as Map import PureFP.Parsers.Parser import Version -version = revised "$Revision: 776 $" - -{- -(?) x y = Map.lookup y x - -mergeWith f = Map.unionWith f - -emptyMap = Map.empty - -mapMap = Map.map - -(|->) x y = Map.insert x y Map.empty --} +version = revised "$Revision: 903 $" data (OrdMap m) => Next m s a = Only (m s a) @@ -182,9 +168,12 @@ (|:|) x y = x y (|-|) :: InputSymbol s => [s] -> [s] -> a -> Mapper s (Quit s a) -(|-|) x y z = if True --length x > length y || length y == 0 +(|-|) x y z = syms x >> Node [returnQuit y z] emptyMap + {- + if length x > length y || length y == 0 then syms x >> Node [returnQuit y z] emptyMap else error "Length requirement violated" + -} (|.|) :: InputSymbol s => [s] -> a -> Mapper s (Quit s a) (|.|) x y = x |-| [] |:| y
Encode/Unicode.hs view
@@ -1,11 +1,11 @@ -- -------------------------------------------------------------------------- --- $Revision: 542 $ $Date: 2008-04-25 23:34:45 +0200 (Fri, 25 Apr 2008) $ +-- $Revision: 931 $ $Date: 2010-01-24 22:32:37 +0100 (Sun, 24 Jan 2010) $ -- -------------------------------------------------------------------------- -- | -- -- Module : Encode.Unicode --- Copyright : Otakar Smrz 2005-2008 +-- Copyright : Otakar Smrz 2005-2010 -- License : GPL -- -- Maintainer : otakar.smrz mff.cuni.cz @@ -39,7 +39,7 @@ import Version -version = revised "$Revision: 542 $" +version = Encode.version data Unicode = Unicode | UCS
Exec/Decode/Main.hs view
@@ -1,11 +1,11 @@ -- -------------------------------------------------------------------------- --- $Revision: 808 $ $Date: 2009-02-10 00:19:07 +0100 (Tue, 10 Feb 2009) $ +-- $Revision: 933 $ $Date: 2010-02-13 16:57:22 +0100 (Sat, 13 Feb 2010) $ -- -------------------------------------------------------------------------- -- | -- -- Module : Exec.Decode.Main --- Copyright : Otakar Smrz 2005-2009 +-- Copyright : Otakar Smrz 2005-2010 -- License : GPL -- -- Maintainer : otakar.smrz mff.cuni.cz @@ -17,6 +17,7 @@ module Main where + import Encode import Encode.Arabic import Encode.Unicode @@ -27,13 +28,10 @@ import Data.Char import Data.List -import Data.Version (showVersion) import Version -version = Version [1, 1, build] [] - - where Version [build] [] = revised "$Revision: 808 $" +version = Encode.version data Opts = DisplayUsage | PrintVersion | LineOriented | @@ -78,17 +76,20 @@ if null errs then case (sort . nub) opts of - DisplayUsage : _ -> warn (usageInfo synopsis options) - PrintVersion : _ -> warn (unlines [copyleft, + DisplayUsage : _ -> tell (usageInfo synopsis options) + PrintVersion : _ -> tell (unlines [copyleft, unwords ["Encode Arabic", showVersion Main.version, - "February 2009"]]) + "February 2010"]]) LineOriented : _ -> execute True (tail opts) nons _ -> execute False opts nons else warn (usageInfo synopsis options) +tell = hPutStr stdout + + warn = hPutStr stderr @@ -113,16 +114,16 @@ decodes = case map toLower e of - "arabtex" -> decode ArabTeX - "lagally" -> decode Lagally - "tex" -> decode TeX + "arabtex" -> decode ArabTeX . encode UCS . decode UTF + "lagally" -> decode Lagally . encode UCS . decode UTF + "tex" -> decode TeX . encode UCS . decode UTF - "zdmg" -> decode ZDMG - "arabtex_zdmg" -> decode ArabTeX_ZDMG - "arabtex-zdmg" -> decode ArabTeX_ZDMG + "zdmg" -> decode ZDMG . encode UCS . decode UTF + "arabtex_zdmg" -> decode ArabTeX_ZDMG . encode UCS . decode UTF + "arabtex-zdmg" -> decode ArabTeX_ZDMG . encode UCS . decode UTF - "buckwalter" -> decode Buckwalter - "tim" -> decode Tim + "buckwalter" -> decode Buckwalter . encode UCS . decode UTF + "tim" -> decode Tim . encode UCS . decode UTF "winarabic" -> decode WinArabic "cp1256" -> decode CP1256
Exec/Encode/Main.hs view
@@ -1,11 +1,11 @@ -- -------------------------------------------------------------------------- --- $Revision: 808 $ $Date: 2009-02-10 00:19:07 +0100 (Tue, 10 Feb 2009) $ +-- $Revision: 933 $ $Date: 2010-02-13 16:57:22 +0100 (Sat, 13 Feb 2010) $ -- -------------------------------------------------------------------------- -- | -- -- Module : Exec.Encode.Main --- Copyright : Otakar Smrz 2005-2009 +-- Copyright : Otakar Smrz 2005-2010 -- License : GPL -- -- Maintainer : otakar.smrz mff.cuni.cz @@ -17,6 +17,7 @@ module Main where + import Encode import Encode.Arabic import Encode.Unicode @@ -27,13 +28,10 @@ import Data.Char import Data.List -import Data.Version (showVersion) import Version -version = Version [1, 1, build] [] - - where Version [build] [] = revised "$Revision: 808 $" +version = Encode.version data Opts = DisplayUsage | PrintVersion | LineOriented | @@ -78,17 +76,20 @@ if null errs then case (sort . nub) opts of - DisplayUsage : _ -> warn (usageInfo synopsis options) - PrintVersion : _ -> warn (unlines [copyleft, + DisplayUsage : _ -> tell (usageInfo synopsis options) + PrintVersion : _ -> tell (unlines [copyleft, unwords ["Encode Arabic", showVersion Main.version, - "February 2009"]]) + "February 2010"]]) LineOriented : _ -> execute True (tail opts) nons _ -> execute False opts nons else warn (usageInfo synopsis options) +tell = hPutStr stdout + + warn = hPutStr stderr @@ -113,16 +114,16 @@ encodes = case map toLower e of - "arabtex" -> encode ArabTeX - "lagally" -> encode Lagally - "tex" -> encode TeX + "arabtex" -> encode UTF . decode UCS . encode ArabTeX + "lagally" -> encode UTF . decode UCS . encode Lagally + "tex" -> encode UTF . decode UCS . encode TeX - "zdmg" -> encode ZDMG - "arabtex_zdmg" -> encode ArabTeX_ZDMG - "arabtex-zdmg" -> encode ArabTeX_ZDMG + "zdmg" -> encode UTF . decode UCS . encode ZDMG + "arabtex_zdmg" -> encode UTF . decode UCS . encode ArabTeX_ZDMG + "arabtex-zdmg" -> encode UTF . decode UCS . encode ArabTeX_ZDMG - "buckwalter" -> encode Buckwalter - "tim" -> encode Tim + "buckwalter" -> encode UTF . decode UCS . encode Buckwalter + "tim" -> encode UTF . decode UCS . encode Tim "winarabic" -> encode WinArabic "cp1256" -> encode CP1256