diff --git a/Encode.cabal b/Encode.cabal --- a/Encode.cabal +++ b/Encode.cabal @@ -1,13 +1,13 @@ name: Encode -version: 1.3.7 +version: 1.3.8 license: GPL license-file: LICENSE -extra-source-files: INSTALL, Setup.PL -copyright: 2014 +extra-source-files: README.md +copyright: 2016 author: Otakar Smrz maintainer: otakar-smrz users.sf.net homepage: http://otakar-smrz.users.sf.net/ -package-url: http://sourceforge.net/projects/encode-arabic/ +package-url: http://github.com/otakar-smrz/encode-arabic/ category: Text, Codec build-depends: Cabal, base < 5.0, mtl, containers build-type: Simple @@ -50,14 +50,7 @@ University and Chalmers University of Technology, April 2002, . . - The "Parsek" library is included for experimental purposes and subsumes - "PureFP.Parsers.Stream". /Parsek/ was developed by Koen Claessen in his - functional pearl article /Parallel Parsing Processes/, Journal of - Functional Programming, 14(6), 741–757, Cambridge University Press, - 2004, , - . - . - "Encode" "PureFP" "Parsek" + "Encode" "PureFP" exposed-modules: Encode, Encode.Arabic, Encode.Arabic.ArabTeX, @@ -83,8 +76,7 @@ PureFP.Parsers.Parser, PureFP.Parsers.Standard, PureFP.Parsers.Stream, - PureFP.Parsers.Trie, - Parsek + PureFP.Parsers.Trie extensions: MultiParamTypeClasses, FunctionalDependencies, ExistentialQuantification, @@ -121,8 +113,7 @@ PureFP.Parsers.Parser, PureFP.Parsers.Standard, PureFP.Parsers.Stream, - PureFP.Parsers.Trie, - Parsek + PureFP.Parsers.Trie extensions: MultiParamTypeClasses, FunctionalDependencies, ExistentialQuantification, @@ -159,8 +150,7 @@ PureFP.Parsers.Parser, PureFP.Parsers.Standard, PureFP.Parsers.Stream, - PureFP.Parsers.Trie, - Parsek + PureFP.Parsers.Trie extensions: MultiParamTypeClasses, FunctionalDependencies, ExistentialQuantification, diff --git a/Encode.hs b/Encode.hs --- a/Encode.hs +++ b/Encode.hs @@ -1,7 +1,7 @@ -- | -- -- Module : Encode --- Copyright : Otakar Smrz 2005-2014 +-- Copyright : Otakar Smrz 2005-2016 -- License : GPL -- -- Maintainer : otakar-smrz users.sf.net diff --git a/Encode/Arabic/ArabTeX.hs b/Encode/Arabic/ArabTeX.hs --- a/Encode/Arabic/ArabTeX.hs +++ b/Encode/Arabic/ArabTeX.hs @@ -1,7 +1,7 @@ -- | -- -- Module : Encode.Arabic.ArabTeX --- Copyright : Otakar Smrz 2005-2014 +-- Copyright : Otakar Smrz 2005-2016 -- License : GPL -- -- Maintainer : otakar-smrz users.sf.net @@ -133,14 +133,14 @@ else case envMode e of Fullvocalize -> if envWasla e - then [ j ++ drop 1 n | j <- theWasla, - n <- noChange ] + then [ j ++ dropOne n | j <- theWasla, + n <- noChange ] else [ j ++ n | j <- justAlif, n <- noChange ] Vocalize -> if envWasla e - then [ j ++ drop 1 n | j <- justAlif, - n <- noChange ] + then [ j ++ dropOne n | j <- justAlif, + n <- noChange ] else [ j ++ n | j <- justAlif, n <- noChange ] @@ -172,6 +172,9 @@ [0x0656, 0x0657, 0x0670]) . ((/=) . fromEnum)) s | s <- lookupList x l ] + + dropOne (_:xs) = xs + dropOne [] = [] shaddaControl :: (OrdMap m, Ord s) => s -> [m s [a]] -> Environ -> [[a]] diff --git a/Encode/Arabic/ArabTeX/ZDMG.hs b/Encode/Arabic/ArabTeX/ZDMG.hs --- a/Encode/Arabic/ArabTeX/ZDMG.hs +++ b/Encode/Arabic/ArabTeX/ZDMG.hs @@ -1,7 +1,7 @@ -- | -- -- Module : Encode.Arabic.ArabTeX.ZDMG --- Copyright : Otakar Smrz 2005-2014 +-- Copyright : Otakar Smrz 2005-2016 -- License : GPL -- -- Maintainer : otakar-smrz users.sf.net @@ -111,14 +111,17 @@ Just _ -> if envQuote e then theWasla else noChange Nothing -> if envQuote e then noChange else - if envWasla e then [ t ++ drop 1 n | t <- theWasla, - n <- noChange ] + if envWasla e then [ t ++ dropOne n | t <- theWasla, + n <- noChange ] else noChange _ -> noChange where theWasla = lookupList "W" [wasla] noChange = lookupList x l + + dropOne (_:xs) = xs + dropOne [] = [] shaddaControl :: (OrdMap m, Ord s) => s -> [m s [a]] -> Environ -> [[a]] diff --git a/Encode/ExPlus.hs b/Encode/ExPlus.hs --- a/Encode/ExPlus.hs +++ b/Encode/ExPlus.hs @@ -1,7 +1,7 @@ -- | -- -- Module : Encode.ExPlus --- Copyright : Otakar Smrz 2005-2011 +-- Copyright : Otakar Smrz 2005-2016 -- License : GPL -- -- Maintainer : otakar-smrz users.sf.net @@ -55,7 +55,6 @@ import Control.Monad import Control.Monad.State -import Control.Monad.Trans class ExtEnv e where @@ -135,7 +134,7 @@ upper s l = foldM (\ f -> fmap ((.) f) . anyof . map (return . (++))) id [ lookupList x l | x <- s ] {- -upper :: (Ord s, Monad m, Functor m, Monoid m) +upper :: (Ord s, Monad m, Functor m, Monoid' m) => [s] -> [Map s [UPoint]] -> m [UPoint] upper s l = (fmap concat . sequence . map (anyof . map return)) [ lookupList x l | x <- s ] @@ -152,7 +151,7 @@ -- the standard parser from section 3.2 -instance Monoid (Extend e s) where +instance Monoid' (Extend e s) where zero = lift zero p <+> q = StateT (\s -> runStateT p s <+> runStateT q s) diff --git a/Encode/Extend.hs b/Encode/Extend.hs --- a/Encode/Extend.hs +++ b/Encode/Extend.hs @@ -1,7 +1,7 @@ -- | -- -- Module : Encode.Extend --- Copyright : Otakar Smrz 2005-2011 +-- Copyright : Otakar Smrz 2005-2016 -- License : GPL -- -- Maintainer : otakar-smrz users.sf.net @@ -51,8 +51,11 @@ import PureFP.OrdMap + import PureFP.Parsers.Parser +import Control.Applicative hiding ((<|>)) + import Control.Monad @@ -131,7 +134,7 @@ upper s l = foldM (\ f -> fmap ((.) f) . anyof . map (return . (++))) id [ lookupList x l | x <- s ] {- -upper :: (Ord s, Monad m, Functor m, Monoid m) +upper :: (Ord s, Monad m, Functor m, Monoid' m) => [s] -> [Map s [UPoint]] -> m [UPoint] upper s l = (fmap concat . sequence . map (anyof . map return)) [ lookupList x l | x <- s ] @@ -148,13 +151,18 @@ -- the standard parser from section 3.2 -instance Monoid (Extend e s) where +instance Monoid' (Extend e s) where zero = Ext (\ inp -> []) Ext p <+> Ext q = Ext (\ inp -> p inp ++ q inp) +instance Applicative (Extend e s) where + pure a = Ext (\ inp -> [(inp, a)]) + (<*>) = ap + + instance Monad (Extend e s) where - return a = Ext (\ inp -> [(inp, a)]) + return = pure Ext p >>= k = Ext (\ inp -> concat [ q inp' | (inp', a) <- p inp, let Ext q = k a ]) @@ -168,7 +176,7 @@ instance Sequence (Extend e s) {-- - Ext p <*> Ext q = Ext (\inp -> [ (inp'', f a) | (inp', f) <- p inp, (inp'', a) <- q inp' ]) + Ext p Ext q = Ext (\inp -> [ (inp'', f a) | (inp', f) <- p inp, (inp'', a) <- q inp' ]) --} diff --git a/Encode/Mapper.hs b/Encode/Mapper.hs --- a/Encode/Mapper.hs +++ b/Encode/Mapper.hs @@ -1,7 +1,7 @@ -- | -- -- Module : Encode.Mapper --- Copyright : Otakar Smrz 2005-2011 +-- Copyright : Otakar Smrz 2005-2016 -- License : GPL -- -- Maintainer : otakar-smrz users.sf.net @@ -54,11 +54,15 @@ import PureFP.Parsers.Parser +import Control.Applicative hiding (many, some) -data (OrdMap m) => Next m s a = Only (m s a) - | Else (m s a) (s -> Maybe a) +import Control.Monad +data Next m s a = Only (m s a) + | Else (m s a) (s -> Maybe a) + + perhaps :: Maybe a -> Maybe a -> Maybe a perhaps x y = case x of Nothing -> y _ -> x @@ -174,20 +178,20 @@ (|+|) = (<+>) -anySymbol :: (Monoid m, Symbol m a) => [a] -> m a +anySymbol :: (Monoid' m, Symbol m a) => [a] -> m a anySymbol = anyof . map sym -some :: (Monoid m, Sequence m) => m a -> m [a] +some :: (Monoid' m, Sequence m) => m a -> m [a] some p = p <:> many p infixl 5 <->, <.> -(<->) :: (Monoid m, Sequence m) => m a -> b -> m ([c], b) +(<->) :: (Monoid' m, Sequence m) => m a -> b -> m ([c], b) (<->) x y = x <.> return ([], y) -(<.>) :: (Monoid m, Sequence m) => m a -> m b -> m b -(<.>) = (*>) +(<.>) :: (Monoid' m, Sequence m) => m a -> m b -> m b +(<.>) = (/>) -------------------------------------------------- -- the ambiguous extended trie from section 4.3.4 @@ -203,7 +207,7 @@ unfoldTrie node = node -instance Ord s => Monoid (Mapper s) where +instance Ord s => Monoid' (Mapper s) where zero = Node [] emptyMap FMap f p <+> q = unfoldWith f p <+> q @@ -217,8 +221,13 @@ -} +instance Ord s => Applicative (Mapper s) where + pure a = Node [a] emptyMap + (<*>) = ap + + instance Ord s => Monad (Mapper s) where - return a = Node [a] emptyMap + return = pure FMap f p >>= k = unfoldWith f p >>= k Node as pmap >>= k = foldr (<+>) (Node [] (mapMap (>>= k) pmap)) (map k as) diff --git a/Encode/Version.hs b/Encode/Version.hs --- a/Encode/Version.hs +++ b/Encode/Version.hs @@ -1,7 +1,7 @@ -- | -- -- Module : Encode.Version --- Copyright : Otakar Smrz 2005-2014 +-- Copyright : Otakar Smrz 2005-2016 -- License : GPL -- -- Maintainer : otakar-smrz users.sf.net @@ -44,4 +44,4 @@ revised revision = fst . last . readP_to_S parseVersion $ words revision !! 1 -version = Version [1, 3, 7] ["August 2014"] +version = Version [1, 3, 8] ["May 2016"] diff --git a/INSTALL b/INSTALL deleted file mode 100644 --- a/INSTALL +++ /dev/null @@ -1,51 +0,0 @@ -INSTALLATION INSTRUCTIONS - -This package is prepared with Cabal. You need some Haskell compiler installed -that understands Cabal and Haddock. - - http://www.haskell.org/ghc/ - http://www.haskell.org/hugs/ - - http://www.haskell.org/cabal/ - http://www.haskell.org/haddock/ - - -1) Unpack the source distribution of this package and move to its root - directory. You have probably done so already, since you are reading these - instructions. - -2) From the command line, run the following (runhaskell is runghc or runhugs): - - runhaskell Setup.hs --help - - You can then build the package, install it, generate the documentation, ... - - runhaskell Setup.hs configure - runhaskell Setup.hs build - runhaskell Setup.hs haddock - runhaskell Setup.hs install - - Alternatively, you can load Setup.hs into the interpreters (Hugs, GHCi) and - run the following commands from within them: - - :load Setup.hs - - :main --help - - :main configure - :main build - :main haddock - :main install - - If you have Perl installed, you can simply run Setup.PL to do everything: - - perl Setup.PL - - -In case you need more help, please consult the Cabal documentation website. - - http://www.haskell.org/cabal/release/latest/doc/users-guide/builders.html - http://www.haskell.org/cabal/release/latest/doc/users-guide/ - - -Enjoy! ^^ diff --git a/Main/Decode.hs b/Main/Decode.hs --- a/Main/Decode.hs +++ b/Main/Decode.hs @@ -1,7 +1,7 @@ -- | -- -- Module : Main.Decode --- Copyright : Otakar Smrz 2005-2013 +-- Copyright : Otakar Smrz 2005-2016 -- License : GPL -- -- Maintainer : otakar-smrz users.sf.net @@ -53,12 +53,12 @@ "show program's version" ] -copyleft = unlines ["Encode Arabic (C) 2013-2005 Otakar Smrz", +copyleft = unlines ["Encode Arabic (C) 2016-2005 Otakar Smrz", "GNU General Public License http://www.gnu.org/licenses/"] synopsis = unlines [copyleft, - " http://sourceforge.net/projects/encode-arabic/", - " http://encode-arabic.sourceforge.net/", + " http://github.com/otakar-smrz/encode-arabic/", + " http://encode-arabic.sf.net/", " ", "", "decode [--OPTIONS] [ENCODING]"] diff --git a/Main/Encode.hs b/Main/Encode.hs --- a/Main/Encode.hs +++ b/Main/Encode.hs @@ -1,7 +1,7 @@ -- | -- -- Module : Main.Encode --- Copyright : Otakar Smrz 2005-2013 +-- Copyright : Otakar Smrz 2005-2016 -- License : GPL -- -- Maintainer : otakar-smrz users.sf.net @@ -53,12 +53,12 @@ "show program's version" ] -copyleft = unlines ["Encode Arabic (C) 2013-2005 Otakar Smrz", +copyleft = unlines ["Encode Arabic (C) 2016-2005 Otakar Smrz", "GNU General Public License http://www.gnu.org/licenses/"] synopsis = unlines [copyleft, - " http://sourceforge.net/projects/encode-arabic/", - " http://encode-arabic.sourceforge.net/", + " http://github.com/otakar-smrz/encode-arabic/", + " http://encode-arabic.sf.net/", " ", "", "encode [--OPTIONS] [ENCODING]"] diff --git a/Parsek.hs b/Parsek.hs deleted file mode 100644 --- a/Parsek.hs +++ /dev/null @@ -1,553 +0,0 @@ --- | --- --- Module : Parsek --- Copyright : Koen Claessen 2003 --- License : GPL --- --- Maintainer : otakar-smrz users.sf.net --- Stability : provisional --- Portability : portable --- --- This module provides the /Parsek/ library developed by Koen Claessen in his --- functional pearl article /Parallel Parsing Processes/, Journal of Functional --- Programming, 14(6), 741–757, Cambridge University Press, 2004: --- --- --- --- --- Copyright (C) 2003 Koen Claessen --- --- 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., --- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. --- --- --- "PureFP.Parsers.Stream" - ------------------------------------------------------------------- --- Parsek, a Parser Combinator Library -- --- Copyright (c) 2003 Koen Claessen -- --- koen@cs.chalmers.se -- --- -- --- This file is part of Parsek. -- --- -- --- Parsek 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. -- --- -- --- Parsek 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 Parsek; if not, write to the Free -- --- Software Foundation, Inc., 59 Temple Place, Suite 330, -- --- Boston, MA 02111-1307 USA. -- ------------------------------------------------------------------- - -module Parsek - -- basic parser type - ( Parser -- :: * -> * -> *; Functor, Monad, MonadPlus - , Expect -- :: *; = [String] - , Unexpect -- :: *; = [String] - - -- parsers - , satisfy -- :: Show s => (s -> Bool) -> Parser s s - , look -- :: Parser s [s] - , succeeds -- :: Parser s a -> Parser s (Maybe a) - , string -- :: (Eq s, Show s) => [s] -> Parser s [s] - - , char -- :: Eq s => s -> Parser s s - , noneOf -- :: Eq s => [s] -> Parser s s - , oneOf -- :: Eq s => [s] -> Parser s s - - , spaces -- :: Parser Char () - , space -- :: Parser Char Char - , newline -- :: Parser Char Char - , tab -- :: Parser Char Char - , upper -- :: Parser Char Char - , lower -- :: Parser Char Char - , alphaNum -- :: Parser Char Char - , letter -- :: Parser Char Char - , digit -- :: Parser Char Char - , hexDigit -- :: Parser Char Char - , octDigit -- :: Parser Char Char - , anyChar -- :: Parser s s - , anySymbol -- :: Parser s s - , munch, munch1 -- :: (s -> Bool) -> Parser s [s] - - -- parser combinators - , label -- :: String -> Parser s a -> Parser s a - , () -- :: Parser s a -> String -> Parser s a - , pzero -- :: Parser s a - , (<|>) -- :: Parser s a -> Parser s a -> Parser s a - , (<<|>) -- :: Parser s a -> Parser s a -> Parser s a - , try -- :: Parser s a -> Parser s a; = id - , choice -- :: [Parser s a] -> Parser s a - , option -- :: a -> Parser s a -> Parser s a - , optional -- :: Parser s a -> Parser s () - , between -- :: Parser s open -> Parser s close -> Parser s a -> Parser s a - , count -- :: Int -> Parser s a -> Parser s [a] - - , chainl1 -- :: Parser s a -> Parser s (a -> a -> a) -> Parser s a - , chainl -- :: Parser s a -> Parser s (a -> a -> a) -> a -> Parser s a - , chainr1 -- :: Parser s a -> Parser s (a -> a -> a) -> Parser s a - , chainr -- :: Parser s a -> Parser s (a -> a -> a) -> a -> Parser s a - - , skipMany1 -- :: Parser s a -> Parser s () - , skipMany -- :: Parser s a -> Parser s () - , many1 -- :: Parser s a -> Parser s [a] - , many -- :: Parser s a -> Parser s [a] - , sepBy1 -- :: Parser s a -> Parser s sep -> Parser s [a] - , sepBy -- :: Parser s a -> Parser s sep -> Parser s [a] - - -- parsing & parse methods - , ParseMethod -- :: * -> * -> * -> * -> * - , ParseResult -- :: * -> * -> *; = Either (e, Expect, Unexpect) r - , parseFromFile -- :: Parser Char a -> ParseMethod Char a e r -> FilePath -> IO (ParseResult e r) - , parse -- :: Parser s a -> ParseMethod s a e r -> [s] -> ParseResult e r - - , shortestResult -- :: ParseMethod s a (Maybe s) a - , longestResult -- :: ParseMethod s a (Maybe s) a - , longestResults -- :: ParseMethod s a (Maybe s) [a] - , allResults -- :: ParseMethod s a (Maybe s) [a] - , allResultsStaged -- :: ParseMethod s a (Maybe s) [[a]] - , completeResults -- :: ParseMethod s a (Maybe s) [a] - - , shortestResultWithLeftover -- :: ParseMethod s a (Maybe s) (a,[s]) - , longestResultWithLeftover -- :: ParseMethod s a (Maybe s) (a,[s]) - , longestResultsWithLeftover -- :: ParseMethod s a (Maybe s) ([a],[s]) - , allResultsWithLeftover -- :: ParseMethod s a (Maybe s) [(a,[s])] - - , completeResultsWithLine -- :: ParseMethod Char a Int [a] - ) - where - -import Control.Monad - ( MonadPlus(..) - , guard - ) - -import Data.List - ( union - , intersperse - ) - -import Data.Char - -infix 0 -infixr 1 <|>, <<|> - -------------------------------------------------------------------------- --- type Parser - -newtype Parser s a - = Parser (forall res . (a -> Expect -> P s res) -> Expect -> P s res) - --- type P; parsing processes - -data P s res - = Symbol (s -> P s res) - | Look ([s] -> P s res) - | Fail Expect Unexpect - | Result res (P s res) - --- type Expect, Unexpect - -type Expect - = [String] - -type Unexpect - = [String] - -------------------------------------------------------------------------- --- instances: Functor, Monad, MonadPlus - -instance Functor (Parser s) where - fmap p (Parser f) = - Parser (\fut -> f (fut . p)) - -instance Monad (Parser s) where - return a = - Parser (\fut -> fut a) - - Parser f >>= k = - Parser (\fut -> f (\a -> let Parser g = k a in g fut)) - - fail s = - Parser (\fut exp -> Fail exp [s]) - -instance MonadPlus (Parser s) where - mzero = - Parser (\fut exp -> Fail exp []) - - mplus (Parser f) (Parser g) = - Parser (\fut exp -> f fut exp `plus` g fut exp) - -plus :: P s res -> P s res -> P s res -Symbol fut1 `plus` Symbol fut2 = Symbol (\s -> fut1 s `plus` fut2 s) -Fail exp1 err1 `plus` Fail exp2 err2 = Fail (exp1 `union` exp2) (err1 `union` err2) -p `plus` Result res q = Result res (p `plus` q) -Result res p `plus` q = Result res (p `plus` q) -Look fut1 `plus` Look fut2 = Look (\s -> fut1 s `plus` fut2 s) -Look fut1 `plus` q = Look (\s -> fut1 s `plus` q) -p `plus` Look fut2 = Look (\s -> p `plus` fut2 s) -p@(Symbol _) `plus` _ = p -_ `plus` q@(Symbol _) = q - -------------------------------------------------------------------------- --- primitive parsers - -anySymbol :: Parser s s -anySymbol = - Parser (\fut exp -> Symbol (\c -> - fut c [] - )) - -satisfy :: Show s => (s -> Bool) -> Parser s s -satisfy pred = - Parser (\fut exp -> Symbol (\c -> - if pred c - then fut c [] - else Fail exp [show [c]] - )) - -label :: Parser s a -> String -> Parser s a -label (Parser f) s = - Parser (\fut exp -> - if null exp - then f (\a _ -> fut a []) [s] - else f fut exp - ) - -look :: Parser s [s] -look = - Parser (\fut exp -> - Look (\s -> fut s exp) - ) - -succeeds :: Parser s a -> Parser s (Maybe a) -succeeds (Parser f) = - Parser (\fut exp -> - Look (\xs -> - let sim (Symbol f) q (x:xs) = sim (f x) (\k -> Symbol (\_ -> q k)) xs - sim (Look f) q xs = sim (f xs) q xs - sim p@(Result _ _) q xs = q (cont p) - sim _ _ _ = fut Nothing [] - - cont (Symbol f) = Symbol (\x -> cont (f x)) - cont (Look f) = Look (\s -> cont (f s)) - cont (Result a p) = fut (Just a) [] `plus` cont p - cont (Fail exp unexp) = Fail exp unexp - - in sim (f (\a _ -> Result a (Fail [] [])) exp) id xs - ) - ) - --- specialized - -string :: (Eq s, Show s) => [s] -> Parser s [s] -string s = - Parser (\fut exp -> - let inputs [] = fut s [] - inputs (x:xs) = - Symbol (\c -> - if c == x - then inputs xs - else Fail (if null exp then [show s] else exp) [show [c]] - ) - - in inputs s - ) - -------------------------------------------------------------------------- --- derived parsers - -char c = satisfy (==c) show [c] -noneOf cs = satisfy (\c -> not (c `elem` cs)) -oneOf cs = satisfy (\c -> c `elem` cs) - -spaces = skipMany space "white space" -space = satisfy (isSpace) "space" -newline = char '\n' "new-line" -tab = char '\t' "tab" -upper = satisfy (isUpper) "uppercase letter" -lower = satisfy (isLower) "lowercase letter" -alphaNum = satisfy (isAlphaNum) "letter or digit" -letter = satisfy (isAlpha) "letter" -digit = satisfy (isDigit) "digit" -hexDigit = satisfy (isHexDigit) "hexadecimal digit" -octDigit = satisfy (isOctDigit) "octal digit" -anyChar = anySymbol - -munch :: (s -> Bool) -> Parser s [s] -munch p = - do cs <- look - scan cs - where - scan (c:cs) | p c = do anySymbol; as <- scan cs; return (c:as) - scan _ = do return [] - -munch1 :: Show s => (s -> Bool) -> Parser s [s] -munch1 p = - do c <- satisfy p - cs <- munch p - return (c:cs) - ------------------------------------------------------------ --- parser combinators - -() :: Parser s a -> String -> Parser s a -p s = label p s - -pzero :: Parser s a -pzero = mzero - -(<|>) :: Parser s a -> Parser s a -> Parser s a -p <|> q = p `mplus` q - -(<<|>) :: Parser s a -> Parser s a -> Parser s a -p <<|> q = - do ma <- succeeds p - case ma of - Nothing -> q - Just a -> return a - -try :: Parser s a -> Parser s a -try p = p -- backwards compatibility with Parsec - -choice :: [Parser s a] -> Parser s a -choice ps = foldr (<|>) mzero ps - -option :: a -> Parser s a -> Parser s a -option x p = p <|> return x - -optional :: Parser s a -> Parser s () -optional p = (do p; return ()) <|> return () - -between :: Parser s open -> Parser s close -> Parser s a -> Parser s a -between open close p = do open; x <- p; close; return x - --- repetition - -skipMany1,skipMany :: Parser s a -> Parser s () -skipMany1 p = do p; skipMany p -skipMany p = let scan = (do p; scan) <|> return () in scan - -many1,many :: Parser s a -> Parser s [a] -many1 p = do x <- p; xs <- many p; return (x:xs) -many p = let scan f = (do x <- p; scan (f.(x:))) <|> return (f []) in scan id - -sepBy1,sepBy :: Parser s a -> Parser s sep -> Parser s [a] -sepBy p sep = sepBy1 p sep <|> return [] -sepBy1 p sep = do x <- p; xs <- many (do sep; p); return (x:xs) - -count :: Int -> Parser s a -> Parser s [a] -count n p = sequence (replicate n p) - -chainr,chainl :: Parser s a -> Parser s (a -> a -> a) -> a -> Parser s a -chainr p op x = chainr1 p op <|> return x -chainl p op x = chainl1 p op <|> return x - -chainr1,chainl1 :: Parser s a -> Parser s (a -> a -> a) -> Parser s a -chainr1 p op = scan - where - scan = do x <- p; rest x - rest x = (do f <- op; y <- scan; return (f x y)) <|> return x - -chainl1 p op = scan - where - scan = do x <- p; rest x - rest x = (do f <- op; y <- p; rest (f x y)) <|> return x - -------------------------------------------------------------------------- --- type ParseMethod, ParseResult - -type ParseMethod s a e r - = P s a -> [s] -> ParseResult e r - -type ParseResult e r - = Either (e, Expect, Unexpect) r - --- parse functions - -parseFromFile :: Parser Char a -> ParseMethod Char a e r -> FilePath -> IO (ParseResult e r) -parseFromFile p method file = - do s <- readFile file - return (parse p method s) - -parse :: Parser s a -> ParseMethod s a e r -> [s] -> ParseResult e r -parse (Parser f) method xs = - case method (f (\a exp -> Result a (Fail exp [])) []) xs of - Left (err, exp, unexp) -> Left (err, [ s | s@(_:_) <- exp ], unexp) - Right x -> Right x - --- parse methods - -shortestResult :: ParseMethod s a (Maybe s) a -shortestResult p xs = scan p xs - where - scan (Symbol sym) (x:xs) = scan (sym x) xs - scan (Symbol _) [] = scan (Fail [] []) [] - scan (Result res _) _ = Right res - scan (Fail exp err) (x:xs) = failSym x exp err - scan (Fail exp err) [] = failEof exp err - scan (Look f) xs = scan (f xs) xs - -longestResult :: ParseMethod s a (Maybe s) a -longestResult p xs = scan p Nothing xs - where - scan (Symbol sym) mres (x:xs) = scan (sym x) mres xs - scan (Symbol _) mres [] = scan (Fail [] []) mres [] - scan (Result res p) _ xs = scan p (Just res) xs - scan (Fail exp err) Nothing (x:xs) = failSym x exp err - scan (Fail exp err) Nothing [] = failEof exp err - scan (Fail _ _) (Just res) _ = Right res - scan (Look f) mres xs = scan (f xs) mres xs - -longestResults :: ParseMethod s a (Maybe s) [a] -longestResults p xs = scan p [] [] xs - where - scan (Symbol sym) [] old (x:xs) = scan (sym x) [] old xs - scan (Symbol sym) new old (x:xs) = scan (sym x) [] new xs - scan (Symbol _) new old [] = scan (Fail [] []) new old [] - scan (Result res p) new old xs = scan p (res:new) [] xs - scan (Fail exp err) [] [] (x:xs) = failSym x exp err - scan (Fail exp err) [] [] [] = failEof exp err - scan (Fail _ _) [] old _ = Right old - scan (Fail _ _) new _ _ = Right new - scan (Look f) new old xs = scan (f xs) new old xs - -allResultsStaged :: ParseMethod s a (Maybe s) [[a]] -allResultsStaged p xs = Right (scan p [] xs) - where - scan (Symbol sym) ys (x:xs) = ys : scan (sym x) [] xs - scan (Symbol _) ys [] = [ys] - scan (Result res p) ys xs = scan p (res:ys) xs - scan (Fail _ _) ys _ = [ys] - scan (Look f) ys xs = scan (f xs) ys xs - -allResults :: ParseMethod s a (Maybe s) [a] -allResults p xs = scan p xs - where - scan (Symbol sym) (x:xs) = scan (sym x) xs - scan (Symbol _) [] = scan (Fail [] []) [] - scan (Result res p) xs = Right (res : scan' p xs) - scan (Fail exp err) (x:xs) = failSym x exp err - scan (Fail exp err) [] = failEof exp err - scan (Look f) xs = scan (f xs) xs - - scan' p xs = - case scan p xs of - Left _ -> [] - Right ress -> ress - -completeResults :: ParseMethod s a (Maybe s) [a] -completeResults p xs = scan p xs - where - scan (Symbol sym) (x:xs) = scan (sym x) xs - scan (Symbol _) [] = scan (Fail [] []) [] - scan (Result res p) [] = Right (res : scan' p []) - scan (Result _ p) xs = scan p xs - scan (Fail exp err) (x:xs) = failSym x exp err - scan (Fail exp err) [] = failEof exp err - scan (Look f) xs = scan (f xs) xs - - scan' p xs = - case scan p xs of - Left _ -> [] - Right ress -> ress - --- with left overs - -shortestResultWithLeftover :: ParseMethod s a (Maybe s) (a,[s]) -shortestResultWithLeftover p xs = scan p xs - where - scan (Symbol sym) (x:xs) = scan (sym x) xs - scan (Symbol _) [] = scan (Fail [] []) [] - scan (Result res _) xs = Right (res,xs) - scan (Fail exp err) (x:xs) = failSym x exp err - scan (Fail exp err) [] = failEof exp err - scan (Look f) xs = scan (f xs) xs - -longestResultWithLeftover :: ParseMethod s a (Maybe s) (a,[s]) -longestResultWithLeftover p xs = scan p Nothing xs - where - scan (Symbol sym) mres (x:xs) = scan (sym x) mres xs - scan (Symbol _) mres [] = scan (Fail [] []) mres [] - scan (Result res p) _ xs = scan p (Just (res,xs)) xs - scan (Fail exp err) Nothing (x:xs) = failSym x exp err - scan (Fail exp err) Nothing [] = failEof exp err - scan (Fail _ _) (Just resxs) _ = Right resxs - scan (Look f) mres xs = scan (f xs) mres xs - -longestResultsWithLeftover :: ParseMethod s a (Maybe s) ([a],Maybe [s]) -longestResultsWithLeftover p xs = scan p empty empty xs - where - scan (Symbol sym) ([],_) old (x:xs) = scan (sym x) empty old xs - scan (Symbol sym) new old (x:xs) = scan (sym x) empty new xs - scan (Symbol _) new old [] = scan (Fail [] []) new old [] - scan (Result res p) (as,_) old xs = scan p (res:as,Just xs) empty xs - scan (Fail exp err) ([],_) ([],_) (x:xs) = failSym x exp err - scan (Fail exp err) ([],_) ([],_) [] = failEof exp err - scan (Fail _ _) ([],_) old _ = Right old - scan (Fail _ _) new _ _ = Right new - scan (Look f) new old xs = scan (f xs) new old xs - - empty = ([],Nothing) - -allResultsWithLeftover :: ParseMethod s a (Maybe s) [(a,[s])] -allResultsWithLeftover p xs = scan p xs - where - scan (Symbol sym) (x:xs) = scan (sym x) xs - scan (Symbol _) [] = scan (Fail [] []) [] - scan (Result res p) xs = Right ((res,xs) : scan' p xs) - scan (Fail exp err) (x:xs) = failSym x exp err - scan (Fail exp err) [] = failEof exp err - scan (Look f) xs = scan (f xs) xs - - scan' p xs = - case scan p xs of - Left _ -> [] - Right ress -> ress - -completeResultsWithLine :: ParseMethod Char a Int [a] -completeResultsWithLine p xs = scan p 1 xs - where - scan (Symbol sym) n (x:xs) = let n' = x |> n in n' `seq` scan (sym x) n' xs - scan (Symbol _) n [] = scan (Fail [] ["end of file"]) n [] - scan (Result res p) n [] = Right (res : scan' p n []) - scan (Result _ p) n xs = scan p n xs - scan (Fail exp err) n xs = Left (n, exp, err) - scan (Look f) n xs = scan (f xs) n xs - - scan' p n xs = - case scan p n xs of - Left _ -> [] - Right ress -> ress - - '\n' |> n = n+1 - _ |> n = n - --- failing - -failSym :: s -> Expect -> Unexpect -> ParseResult (Maybe s) r -failSym s exp err = Left (Just s, exp, err) - -failEof :: Expect -> Unexpect -> ParseResult (Maybe s) r -failEof exp err = Left (Nothing, exp, err ++ ["end of file"]) - -------------------------------------------------------------------------- --- the end. diff --git a/PureFP/Parsers/AmbExTrie.hs b/PureFP/Parsers/AmbExTrie.hs --- a/PureFP/Parsers/AmbExTrie.hs +++ b/PureFP/Parsers/AmbExTrie.hs @@ -23,9 +23,14 @@ module PureFP.Parsers.AmbExTrie (AmbExTrie (..), unfold) where import PureFP.OrdMap + import PureFP.Parsers.Parser +import Control.Applicative +import Control.Monad + + data AmbExTrie s a = [a] :&: Map s (AmbExTrie s a) | forall b . FMap (b -> a) (AmbExTrie s b) @@ -35,7 +40,7 @@ unfold f (FMap g p) = FMap (f . g) p -instance Ord s => Monoid (AmbExTrie s) where +instance Ord s => Monoid' (AmbExTrie s) where zero = [] :&: emptyMap FMap f p <+> q = unfold f p <+> q @@ -43,8 +48,13 @@ (as:&:pmap) <+> (bs:&:qmap) = (as++bs) :&: mergeWith (<+>) pmap qmap +instance Ord s => Applicative (AmbExTrie s) where + pure a = [a] :&: emptyMap + (<*>) = ap + + instance Ord s => Monad (AmbExTrie s) where - return a = [a] :&: emptyMap + return = pure FMap f p >>= k = unfold f p >>= k (as:&:pmap) >>= k = foldr (<+>) ([]:&:mapMap (>>=k) pmap) (map k as) diff --git a/PureFP/Parsers/AmbTrie.hs b/PureFP/Parsers/AmbTrie.hs --- a/PureFP/Parsers/AmbTrie.hs +++ b/PureFP/Parsers/AmbTrie.hs @@ -23,20 +23,30 @@ module PureFP.Parsers.AmbTrie (AmbTrie (..)) where import PureFP.OrdMap + import PureFP.Parsers.Parser +import Control.Applicative +import Control.Monad + + data AmbTrie s a = [a] :&: Map s (AmbTrie s a) -instance Ord s => Monoid (AmbTrie s) where +instance Ord s => Monoid' (AmbTrie s) where zero = [] :&: emptyMap (as:&:pmap) <+> (bs:&:qmap) = (as++bs) :&: mergeWith (<+>) pmap qmap +instance Ord s => Applicative (AmbTrie s) where + pure a = [a] :&: emptyMap + (<*>) = ap + + instance Ord s => Monad (AmbTrie s) where - return a = [a] :&: emptyMap + return = pure (as:&:pmap) >>= k = foldr (<+>) ([]:&:mapMap (>>=k) pmap) (map k as) diff --git a/PureFP/Parsers/ExTrie.hs b/PureFP/Parsers/ExTrie.hs --- a/PureFP/Parsers/ExTrie.hs +++ b/PureFP/Parsers/ExTrie.hs @@ -23,9 +23,14 @@ module PureFP.Parsers.ExTrie (ExTrie) where import PureFP.OrdMap + import PureFP.Parsers.Parser +import Control.Applicative +import Control.Monad + + data ExTrie s a = Shift (Map s (ExTrie s a)) | a ::: ExTrie s a | forall b . FMap (b -> a) (ExTrie s b) @@ -37,7 +42,7 @@ unfold f (FMap g p) = FMap (f . g) p -instance Ord s => Monoid (ExTrie s) where +instance Ord s => Monoid' (ExTrie s) where zero = Shift emptyMap (a ::: p) <+> q = a ::: (p <+> q) @@ -47,8 +52,13 @@ Shift pmap <+> Shift qmap = Shift (mergeWith (<+>) pmap qmap) +instance Ord s => Applicative (ExTrie s) where + pure a = a ::: zero + (<*>) = ap + + instance Ord s => Monad (ExTrie s) where - return a = a ::: zero + return = pure (a ::: p) >>= k = k a <+> (p >>= k) FMap f p >>= k = unfold f p >>= k diff --git a/PureFP/Parsers/PairTrie.hs b/PureFP/Parsers/PairTrie.hs --- a/PureFP/Parsers/PairTrie.hs +++ b/PureFP/Parsers/PairTrie.hs @@ -23,46 +23,56 @@ module PureFP.Parsers.PairTrie (PairTrie, ParserTrie) where import PureFP.OrdMap + import PureFP.Parsers.Parser +import Control.Applicative +import Control.Monad + + -------------------------------------------------- -- section 4.4.2: pairing a trie with a parser data PairTrie m s a = ParserTrie s (m a) :&: m a -makeParser :: (Ord s, Monoid m, Lookahead m s) => ParserTrie s (m a) -> m a +makeParser :: (Ord s, Monoid' m, Lookahead m s) => ParserTrie s (m a) -> m a makeParser ptrie = lookahead (anyof . parseFull ptrie) -instance (Ord s, Monoid m, Lookahead m s) => Monoid (PairTrie m s) where +instance (Ord s, Monoid' m, Lookahead m s) => Monoid' (PairTrie m s) where zero = zero :&: zero (ptrie :&: _) <+> (qtrie :&: _) = pqtrie :&: makeParser pqtrie where pqtrie = ptrie <+> qtrie -instance (Ord s, Monad m) => Monad (PairTrie m s) where - return a = (p ::: zero) :&: p - where p = return a +instance (Ord s, Monad m, Applicative m) => Applicative (PairTrie m s) where + pure a = (p ::: zero) :&: p + where p = pure a + (<*>) = ap - (>>=) = error "PairTrie: (>>=) is not implemented" +instance (Ord s, Monad m, Applicative m) => Monad (PairTrie m s) where + return = pure + (>>=) = error "PairTrie: (>>=) is not implemented" + + instance (Ord s, Functor m) => Functor (PairTrie m s) where fmap f (trie :&: p) = fmap (fmap f) trie :&: fmap f p -instance (Ord s, Monoid m, Sequence m, Lookahead m s) => Sequence (PairTrie m s) where - (ptrie :&: _) <*> ~(qtrie :&: q) = pqtrie :&: makeParser pqtrie +instance (Ord s, Monoid' m, Sequence m, Applicative m, Lookahead m s) => Sequence (PairTrie m s) where + (ptrie :&: _) ~(qtrie :&: q) = pqtrie :&: makeParser pqtrie where pqtrie = mapPQ ptrie mapPQ (Shift pmap') = Shift (mapMap mapPQ pmap') - mapPQ (p' ::: ptrie') = mapPQ ptrie' <+> fmap (p'<*>) qtrie - mapPQ (Found p' ptrie') = Found (p' <*> q) (mapPQ ptrie') + mapPQ (p' ::: ptrie') = mapPQ ptrie' <+> fmap (p' ) qtrie + mapPQ (Found p' ptrie') = Found (p' q) (mapPQ ptrie') -instance (InputSymbol s, Monoid m, Symbol m s, Lookahead m s) => Symbol (PairTrie m s) s where +instance (InputSymbol s, Monoid' m, Symbol m s, Lookahead m s) => Symbol (PairTrie m s) s where sym s = Found p ptrie :&: p where p = sym s ptrie = Shift (s |-> Found skip (skip ::: zero)) @@ -82,7 +92,7 @@ a ::: ParserTrie s a | Found a (ParserTrie s a) -instance Ord s => Monoid (ParserTrie s) where +instance Ord s => Monoid' (ParserTrie s) where zero = Shift emptyMap Found p ptrie <+> qtrie = ptrie <+> qtrie diff --git a/PureFP/Parsers/Parser.hs b/PureFP/Parsers/Parser.hs --- a/PureFP/Parsers/Parser.hs +++ b/PureFP/Parsers/Parser.hs @@ -29,7 +29,7 @@ module PureFP.Parsers.Parser where infixr 4 <:> -infixl 3 <*> , *> +infixl 3 , /> infixl 2 <+> @@ -45,7 +45,7 @@ -------------------------------------------------- -- the /Monoid/ class (section 2.5) -class Monoid m where +class Monoid' m where zero :: m a (<+>) :: m a -> m a -> m a anyof :: [m a] -> m a @@ -70,10 +70,10 @@ -- of the definitions in section 2.8 class (Monad m, Functor m) => Sequence m where - (<*>) :: m (a -> b) -> m a -> m b - ( *>) :: m a -> m b -> m b - p <*> q = p >>= \f -> fmap f q - p *> q = fmap (\x y -> y) p <*> q + () :: m (a -> b) -> m a -> m b + ( />) :: m a -> m b -> m b + p q = p >>= \f -> fmap f q + p /> q = fmap (\x y -> y) p q {------------------------------------------------- @@ -146,18 +146,18 @@ success :: Monad m => m () success = return () -many0 :: (Monoid m, Sequence m) => m a -> m () +many0 :: (Monoid' m, Sequence m) => m a -> m () many0 p = ps - where ps = success <+> p *> ps + where ps = success <+> p /> ps syms0 :: (Sequence m, Symbol m s) => [s] -> m () syms0 [] = success -syms0 (s:ss) = sym s *> syms0 ss +syms0 (s:ss) = sym s /> syms0 ss (<:>) :: Sequence m => m a -> m [a] -> m [a] -p <:> ps = fmap (:) p <*> ps +p <:> ps = fmap (:) p ps -many :: (Monoid m, Sequence m) => m a -> m [a] +many :: (Monoid' m, Sequence m) => m a -> m [a] many p = ps where ps = return [] <+> p <:> ps diff --git a/PureFP/Parsers/Standard.hs b/PureFP/Parsers/Standard.hs --- a/PureFP/Parsers/Standard.hs +++ b/PureFP/Parsers/Standard.hs @@ -24,6 +24,8 @@ import PureFP.Parsers.Parser +import Control.Applicative + import Control.Monad.State @@ -31,19 +33,22 @@ instance MonadState [s] (Standard s) where - - get = Std (\inp -> [(inp, inp)]) - - put s = Std (\inp -> [(s, ())]) + get = Std (\inp -> [(inp, inp)]) + put s = Std (\inp -> [(s, ())]) -instance Monoid (Standard s) where +instance Monoid' (Standard s) where zero = Std (\inp -> []) Std p <+> Std q = Std (\inp -> p inp ++ q inp) +instance Applicative (Standard s) where + pure a = Std (\inp -> [(inp,a)]) + (<*>) = ap + + instance Monad (Standard s) where - return a = Std (\inp -> [(inp,a)]) + return = pure Std p >>= k = Std (\inp -> concat [ q inp' | (inp', a) <- p inp, let Std q = k a ]) @@ -58,7 +63,7 @@ instance Sequence (Standard s) {-- - Std p <*> Std q = Std (\inp -> [ (inp'', f a) | (inp', f) <- p inp, (inp'', a) <- q inp' ]) + Std p Std q = Std (\inp -> [ (inp'', f a) | (inp', f) <- p inp, (inp'', a) <- q inp' ]) --} diff --git a/PureFP/Parsers/Stream.hs b/PureFP/Parsers/Stream.hs --- a/PureFP/Parsers/Stream.hs +++ b/PureFP/Parsers/Stream.hs @@ -15,7 +15,9 @@ -- -- -- --- "Parsek" +-- +-- +-- "Text.ParserCombinators.Parsek" -------------------------------------------------- @@ -26,13 +28,17 @@ import PureFP.Parsers.Parser +import Control.Applicative +import Control.Monad + + data Stream s a = Shift (s -> Stream s a) | a ::: Stream s a | Nil -instance Monoid (Stream s) where +instance Monoid' (Stream s) where zero = Nil Nil <+> bs = bs @@ -42,8 +48,13 @@ Shift f <+> Shift g = Shift (\s -> f s <+> g s) +instance Applicative (Stream s) where + pure a = a ::: Nil + (<*>) = ap + + instance Monad (Stream s) where - return a = a ::: Nil + return = pure Shift f >>= k = Shift (\s -> f s >>= k) (a:::as) >>= k = k a <+> (as >>= k) @@ -82,5 +93,3 @@ collect _ = [] parseFull (a:::p) inp = parseFull p inp parseFull _ _ = [] - - diff --git a/PureFP/Parsers/Trie.hs b/PureFP/Parsers/Trie.hs --- a/PureFP/Parsers/Trie.hs +++ b/PureFP/Parsers/Trie.hs @@ -23,14 +23,19 @@ module PureFP.Parsers.Trie (Trie) where import PureFP.OrdMap + import PureFP.Parsers.Parser +import Control.Applicative +import Control.Monad + + data Trie s a = Shift (Map s (Trie s a)) | a ::: Trie s a -instance Ord s => Monoid (Trie s) where +instance Ord s => Monoid' (Trie s) where zero = Shift emptyMap (a ::: p) <+> q = a ::: (p <+> q) @@ -38,8 +43,12 @@ Shift pmap <+> Shift qmap = Shift (mergeWith (<+>) pmap qmap) +instance Ord s => Applicative (Trie s) where + pure a = a ::: zero + (<*>) = ap + instance Ord s => Monad (Trie s) where - return a = a ::: zero + return = pure (a ::: p) >>= k = k a <+> (p >>= k) Shift pmap >>= k = Shift (mapMap (>>=k) pmap) @@ -75,7 +84,3 @@ parseFull (Shift pmap) (s:inp) = case pmap ? s of Just p -> parseFull p inp Nothing -> [] - - - - diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,16 @@ +Installing Encode Arabic +======================== + +This package is prepared with [Cabal](https://github.com/haskell/cabal). You need to install [Haskell Platform](https://www.haskell.org/platform) to get it along with the [Haskell](http://www.haskell.org) compiler. + +When done with the above, open the command line, navigate to this directory of the repository, and run the following: + + cabal update + cabal install + +You should then have this package installed, including the library and the binaries: + + encode --help + decode --help + +Enjoy! ^^ diff --git a/Setup.PL b/Setup.PL deleted file mode 100644 --- a/Setup.PL +++ /dev/null @@ -1,224 +0,0 @@ -#! env perl - -# ###################################################################### Otakar Smrz, 2006/11/13 -# -# Building Encode ############################################################################## - -our $VERSION = '1.3.6'; - - -use File::Spec; -use File::Copy; -use File::Which; - - -sub path ($) { - - return File::Spec->join(split ' ', $_[0]); -} - - $DdotsEncodeExecbin = path "..... Encode bin"; - - $Ddots = path "....."; - - $Dbin = path ". bin"; - $Ddoc = path ". doc"; - - $fLICENSE = path ". LICENSE"; - $fSOURCE = path ". SOURCE"; - - $\ = "\n"; - - - $file = path ". Encode.cabal"; - - open C, '<', $file or die "Cannot open " . $file . "!\n"; - - while () { - - $ver = $1 if /^\s* version \s* : \s* ([^\s]+) \s*$/ix; - $url = $1 if /^\s* package-url \s* : \s* ([^\s]+) \s*$/ix; - $author = $1 if /^\s* author \s* : \s* ([^\s]+\ [^\s]+)\s*$/ix; - $maintainer = $1 if /^\s* maintainer \s* : \s* ([^\s]+\ [^\s]+)\s*$/ix; - $homepage = $1 if /^\s* homepage \s* : \s* ([^\s]+) \s*$/ix; - $copyright = $1 if /^\s* copyright \s* : \s* ([^\s]+) \s*$/ix; - } - - close C; - - die "Version not recognized!\n" unless $ver; - die "Package-URL not recognized!\n" unless $url; - die "Author not recognized!\n" unless $author; - die "Maintainer not recognized!\n" unless $maintainer; - die "Homepage not recognized!\n" unless $homepage; - die "Copyright not recognized!\n" unless $copyright; - - - mkdir "dist" unless -d "dist"; - - print "Changing directory: dist"; - chdir "dist"; - - - print "Removing ..."; - - foreach $file ((glob path "Encode doc decode *"), - (glob path "Encode doc encode *"), - (glob path "Encode doc *"), - (glob path "Encode bin *"), - (glob path "Encode *")) { - - print ' <- ' . $file; - - unlink $file; - } - - rmdir path "Encode doc decode"; - rmdir path "Encode doc encode"; - rmdir path "Encode doc"; - rmdir path "Encode bin"; - rmdir path "Encode"; - - die "Remove the " . (path "dist Encode") . " directory first!\n" if -d "Encode"; - - mkdir path "Encode"; - mkdir path "Encode bin"; - mkdir path "Encode doc"; - mkdir path "Encode doc encode"; - mkdir path "Encode doc decode"; - - - print "Changing directory: .."; - chdir ".."; - - - @param = @ARGV ? @ARGV : $^O eq 'MSWin32' ? "--global" - : "--user --prefix $ENV{'HOME'}/.cabal"; - - print "Configuring with parameters: @param"; - - system "runhaskell Setup.hs configure @param"; - system "runhaskell Setup.hs build"; - system "runhaskell Setup.hs haddock --executables"; - system "runhaskell Setup.hs install"; - system "runhaskell Setup.hs sdist"; - - - print "Changing directory: dist"; - chdir "dist"; - - - $path = path "Encode bin"; - - print $path; - - @execs = $^O eq 'MSWin32' ? (path "build encode encode.exe", path "build decode decode.exe") - : (path "build encode encode", path "build decode decode"); - - foreach $file (@execs) { - - print ' <- ' . $file; - - copy $file, $path; - } - - system join " ", "strip", glob path $path . " *" if defined which 'strip'; - - - $path = path "Encode doc encode"; - - print $path; - - foreach $file (glob path "doc html Encode encode *") { - - print ' <- ' . $file; - - move $file, $path; - } - - - $path = path "Encode doc decode"; - - print $path; - - foreach $file (glob path "doc html Encode decode *") { - - print ' <- ' . $file; - - move $file, $path; - } - - - copy path ".. LICENSE", path "Encode"; - - - open S, '>', path "Encode SOURCE"; - - print S << "SOURCE"; - -This software is distributed under the GNU General Public License in $fLICENSE. -The source code for this software can be downloaded from the following address: - - $url - -If experiencing problems, please contact the maintainer of the software: - - $author <$maintainer> - $homepage - -Copyright (C) $copyright $author -SOURCE - - close S; - - - open I, '>', path "Encode INSTALL"; - - print I << "INSTALL"; - -This package includes the $^O-built executables of the "Encode-$ver" library: - - $url - -Before using the programs in the $Dbin directory, please read the license terms -in $fLICENSE and $fSOURCE. The HTML documentation is in the $Ddoc directories. - -In order to run the programs, unpack the contents of the distribution package -and then: - -either execute the programs from within the $Dbin directory - - or copy the contents of the $Dbin directory to some other directory that - is already included in the PATH environment variable - - or extend the setting of the PATH variable with $DdotsEncodeExecbin, where - $Ddots stands for the actual path to the unpacked distribution - -If experiencing problems, please contact the maintainer of the software: - - $author <$maintainer> - $homepage - -Copyright (C) $copyright $author -INSTALL - - close I; - - - $name = "Encode-" . $ver . "-Exec-" . $^O; - - if (defined which 'tar' and defined which 'gzip') { - - system "tar -cf " . $name . ".tar" . " Encode"; - - system "gzip -9 " . $name . ".tar"; - - print "Done with " . $name . ".tar.gz"; - } - - if (defined which 'zip') { - - system "zip -r " . $name . ".zip" . " Encode"; - - print "Done with " . $name . ".zip"; - }