packages feed

PCLT (empty) → 0.1

raw patch · 40 files changed

+5765/−0 lines, 40 filesdep +basedep +bytestringdep +containerssetup-changedbinary-added

Dependencies added: base, bytestring, containers, mtl, utf8-string

Files

+ COPYING view
@@ -0,0 +1,502 @@+		  GNU LESSER GENERAL PUBLIC LICENSE+		       Version 2.1, February 1999++ Copyright (C) 1991, 1999 Free Software Foundation, Inc.+ 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++[This is the first released version of the Lesser GPL.  It also counts+ as the successor of the GNU Library Public License, version 2, hence+ the version number 2.1.]++			    Preamble++  The licenses for most software are designed to take away your+freedom to share and change it.  By contrast, the GNU General Public+Licenses are intended to guarantee your freedom to share and change+free software--to make sure the software is free for all its users.++  This license, the Lesser General Public License, applies to some+specially designated software packages--typically libraries--of the+Free Software Foundation and other authors who decide to use it.  You+can use it too, but we suggest you first think carefully about whether+this license or the ordinary General Public License is the better+strategy to use in any particular case, based on the explanations below.++  When we speak of free software, we are referring to freedom of use,+not price.  Our General Public Licenses are designed to make sure that+you have the freedom to distribute copies of free software (and charge+for this service if you wish); that you receive source code or can get+it if you want it; that you can change the software and use pieces of+it in new free programs; and that you are informed that you can do+these things.++  To protect your rights, we need to make restrictions that forbid+distributors to deny you these rights or to ask you to surrender these+rights.  These restrictions translate to certain responsibilities for+you if you distribute copies of the library or if you modify it.++  For example, if you distribute copies of the library, whether gratis+or for a fee, you must give the recipients all the rights that we gave+you.  You must make sure that they, too, receive or can get the source+code.  If you link other code with the library, you must provide+complete object files to the recipients, so that they can relink them+with the library after making changes to the library and recompiling+it.  And you must show them these terms so they know their rights.++  We protect your rights with a two-step method: (1) we copyright the+library, and (2) we offer you this license, which gives you legal+permission to copy, distribute and/or modify the library.++  To protect each distributor, we want to make it very clear that+there is no warranty for the free library.  Also, if the library is+modified by someone else and passed on, the recipients should know+that what they have is not the original version, so that the original+author's reputation will not be affected by problems that might be+introduced by others.++  Finally, software patents pose a constant threat to the existence of+any free program.  We wish to make sure that a company cannot+effectively restrict the users of a free program by obtaining a+restrictive license from a patent holder.  Therefore, we insist that+any patent license obtained for a version of the library must be+consistent with the full freedom of use specified in this license.++  Most GNU software, including some libraries, is covered by the+ordinary GNU General Public License.  This license, the GNU Lesser+General Public License, applies to certain designated libraries, and+is quite different from the ordinary General Public License.  We use+this license for certain libraries in order to permit linking those+libraries into non-free programs.++  When a program is linked with a library, whether statically or using+a shared library, the combination of the two is legally speaking a+combined work, a derivative of the original library.  The ordinary+General Public License therefore permits such linking only if the+entire combination fits its criteria of freedom.  The Lesser General+Public License permits more lax criteria for linking other code with+the library.++  We call this license the "Lesser" General Public License because it+does Less to protect the user's freedom than the ordinary General+Public License.  It also provides other free software developers Less+of an advantage over competing non-free programs.  These disadvantages+are the reason we use the ordinary General Public License for many+libraries.  However, the Lesser license provides advantages in certain+special circumstances.++  For example, on rare occasions, there may be a special need to+encourage the widest possible use of a certain library, so that it becomes+a de-facto standard.  To achieve this, non-free programs must be+allowed to use the library.  A more frequent case is that a free+library does the same job as widely used non-free libraries.  In this+case, there is little to gain by limiting the free library to free+software only, so we use the Lesser General Public License.++  In other cases, permission to use a particular library in non-free+programs enables a greater number of people to use a large body of+free software.  For example, permission to use the GNU C Library in+non-free programs enables many more people to use the whole GNU+operating system, as well as its variant, the GNU/Linux operating+system.++  Although the Lesser General Public License is Less protective of the+users' freedom, it does ensure that the user of a program that is+linked with the Library has the freedom and the wherewithal to run+that program using a modified version of the Library.++  The precise terms and conditions for copying, distribution and+modification follow.  Pay close attention to the difference between a+"work based on the library" and a "work that uses the library".  The+former contains code derived from the library, whereas the latter must+be combined with the library in order to run.++		  GNU LESSER GENERAL PUBLIC LICENSE+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++  0. This License Agreement applies to any software library or other+program which contains a notice placed by the copyright holder or+other authorized party saying it may be distributed under the terms of+this Lesser General Public License (also called "this License").+Each licensee is addressed as "you".++  A "library" means a collection of software functions and/or data+prepared so as to be conveniently linked with application programs+(which use some of those functions and data) to form executables.++  The "Library", below, refers to any such software library or work+which has been distributed under these terms.  A "work based on the+Library" means either the Library or any derivative work under+copyright law: that is to say, a work containing the Library or a+portion of it, either verbatim or with modifications and/or translated+straightforwardly into another language.  (Hereinafter, translation is+included without limitation in the term "modification".)++  "Source code" for a work means the preferred form of the work for+making modifications to it.  For a library, complete source code means+all the source code for all modules it contains, plus any associated+interface definition files, plus the scripts used to control compilation+and installation of the library.++  Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope.  The act of+running a program using the Library is not restricted, and output from+such a program is covered only if its contents constitute a work based+on the Library (independent of the use of the Library in a tool for+writing it).  Whether that is true depends on what the Library does+and what the program that uses the Library does.++  1. You may copy and distribute verbatim copies of the Library's+complete source code as you receive it, in any medium, provided that+you conspicuously and appropriately publish on each copy an+appropriate copyright notice and disclaimer of warranty; keep intact+all the notices that refer to this License and to the absence of any+warranty; and distribute a copy of this License along with the+Library.++  You may charge a fee for the physical act of transferring a copy,+and you may at your option offer warranty protection in exchange for a+fee.++  2. You may modify your copy or copies of the Library or any portion+of it, thus forming a work based on the Library, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++    a) The modified work must itself be a software library.++    b) You must cause the files modified to carry prominent notices+    stating that you changed the files and the date of any change.++    c) You must cause the whole of the work to be licensed at no+    charge to all third parties under the terms of this License.++    d) If a facility in the modified Library refers to a function or a+    table of data to be supplied by an application program that uses+    the facility, other than as an argument passed when the facility+    is invoked, then you must make a good faith effort to ensure that,+    in the event an application does not supply such function or+    table, the facility still operates, and performs whatever part of+    its purpose remains meaningful.++    (For example, a function in a library to compute square roots has+    a purpose that is entirely well-defined independent of the+    application.  Therefore, Subsection 2d requires that any+    application-supplied function or table used by this function must+    be optional: if the application does not supply it, the square+    root function must still compute square roots.)++These requirements apply to the modified work as a whole.  If+identifiable sections of that work are not derived from the Library,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works.  But when you+distribute the same sections as part of a whole which is a work based+on the Library, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote+it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Library.++In addition, mere aggregation of another work not based on the Library+with the Library (or with a work based on the Library) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++  3. You may opt to apply the terms of the ordinary GNU General Public+License instead of this License to a given copy of the Library.  To do+this, you must alter all the notices that refer to this License, so+that they refer to the ordinary GNU General Public License, version 2,+instead of to this License.  (If a newer version than version 2 of the+ordinary GNU General Public License has appeared, then you can specify+that version instead if you wish.)  Do not make any other change in+these notices.++  Once this change is made in a given copy, it is irreversible for+that copy, so the ordinary GNU General Public License applies to all+subsequent copies and derivative works made from that copy.++  This option is useful when you wish to copy part of the code of+the Library into a program that is not a library.++  4. You may copy and distribute the Library (or a portion or+derivative of it, under Section 2) in object code or executable form+under the terms of Sections 1 and 2 above provided that you accompany+it with the complete corresponding machine-readable source code, which+must be distributed under the terms of Sections 1 and 2 above on a+medium customarily used for software interchange.++  If distribution of object code is made by offering access to copy+from a designated place, then offering equivalent access to copy the+source code from the same place satisfies the requirement to+distribute the source code, even though third parties are not+compelled to copy the source along with the object code.++  5. A program that contains no derivative of any portion of the+Library, but is designed to work with the Library by being compiled or+linked with it, is called a "work that uses the Library".  Such a+work, in isolation, is not a derivative work of the Library, and+therefore falls outside the scope of this License.++  However, linking a "work that uses the Library" with the Library+creates an executable that is a derivative of the Library (because it+contains portions of the Library), rather than a "work that uses the+library".  The executable is therefore covered by this License.+Section 6 states terms for distribution of such executables.++  When a "work that uses the Library" uses material from a header file+that is part of the Library, the object code for the work may be a+derivative work of the Library even though the source code is not.+Whether this is true is especially significant if the work can be+linked without the Library, or if the work is itself a library.  The+threshold for this to be true is not precisely defined by law.++  If such an object file uses only numerical parameters, data+structure layouts and accessors, and small macros and small inline+functions (ten lines or less in length), then the use of the object+file is unrestricted, regardless of whether it is legally a derivative+work.  (Executables containing this object code plus portions of the+Library will still fall under Section 6.)++  Otherwise, if the work is a derivative of the Library, you may+distribute the object code for the work under the terms of Section 6.+Any executables containing that work also fall under Section 6,+whether or not they are linked directly with the Library itself.++  6. As an exception to the Sections above, you may also combine or+link a "work that uses the Library" with the Library to produce a+work containing portions of the Library, and distribute that work+under terms of your choice, provided that the terms permit+modification of the work for the customer's own use and reverse+engineering for debugging such modifications.++  You must give prominent notice with each copy of the work that the+Library is used in it and that the Library and its use are covered by+this License.  You must supply a copy of this License.  If the work+during execution displays copyright notices, you must include the+copyright notice for the Library among them, as well as a reference+directing the user to the copy of this License.  Also, you must do one+of these things:++    a) Accompany the work with the complete corresponding+    machine-readable source code for the Library including whatever+    changes were used in the work (which must be distributed under+    Sections 1 and 2 above); and, if the work is an executable linked+    with the Library, with the complete machine-readable "work that+    uses the Library", as object code and/or source code, so that the+    user can modify the Library and then relink to produce a modified+    executable containing the modified Library.  (It is understood+    that the user who changes the contents of definitions files in the+    Library will not necessarily be able to recompile the application+    to use the modified definitions.)++    b) Use a suitable shared library mechanism for linking with the+    Library.  A suitable mechanism is one that (1) uses at run time a+    copy of the library already present on the user's computer system,+    rather than copying library functions into the executable, and (2)+    will operate properly with a modified version of the library, if+    the user installs one, as long as the modified version is+    interface-compatible with the version that the work was made with.++    c) Accompany the work with a written offer, valid for at+    least three years, to give the same user the materials+    specified in Subsection 6a, above, for a charge no more+    than the cost of performing this distribution.++    d) If distribution of the work is made by offering access to copy+    from a designated place, offer equivalent access to copy the above+    specified materials from the same place.++    e) Verify that the user has already received a copy of these+    materials or that you have already sent this user a copy.++  For an executable, the required form of the "work that uses the+Library" must include any data and utility programs needed for+reproducing the executable from it.  However, as a special exception,+the materials to be distributed need not include anything that is+normally distributed (in either source or binary form) with the major+components (compiler, kernel, and so on) of the operating system on+which the executable runs, unless that component itself accompanies+the executable.++  It may happen that this requirement contradicts the license+restrictions of other proprietary libraries that do not normally+accompany the operating system.  Such a contradiction means you cannot+use both them and the Library together in an executable that you+distribute.++  7. You may place library facilities that are a work based on the+Library side-by-side in a single library together with other library+facilities not covered by this License, and distribute such a combined+library, provided that the separate distribution of the work based on+the Library and of the other library facilities is otherwise+permitted, and provided that you do these two things:++    a) Accompany the combined library with a copy of the same work+    based on the Library, uncombined with any other library+    facilities.  This must be distributed under the terms of the+    Sections above.++    b) Give prominent notice with the combined library of the fact+    that part of it is a work based on the Library, and explaining+    where to find the accompanying uncombined form of the same work.++  8. You may not copy, modify, sublicense, link with, or distribute+the Library except as expressly provided under this License.  Any+attempt otherwise to copy, modify, sublicense, link with, or+distribute the Library is void, and will automatically terminate your+rights under this License.  However, parties who have received copies,+or rights, from you under this License will not have their licenses+terminated so long as such parties remain in full compliance.++  9. You are not required to accept this License, since you have not+signed it.  However, nothing else grants you permission to modify or+distribute the Library or its derivative works.  These actions are+prohibited by law if you do not accept this License.  Therefore, by+modifying or distributing the Library (or any work based on the+Library), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Library or works based on it.++  10. Each time you redistribute the Library (or any work based on the+Library), the recipient automatically receives a license from the+original licensor to copy, distribute, link with or modify the Library+subject to these terms and conditions.  You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties with+this License.++  11. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Library at all.  For example, if a patent+license would not permit royalty-free redistribution of the Library by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Library.++If any portion of this section is held invalid or unenforceable under any+particular circumstance, the balance of the section is intended to apply,+and the section as a whole is intended to apply in other circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system which is+implemented by public license practices.  Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++  12. If the distribution and/or use of the Library is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Library under this License may add+an explicit geographical distribution limitation excluding those countries,+so that distribution is permitted only in or among countries not thus+excluded.  In such case, this License incorporates the limitation as if+written in the body of this License.++  13. The Free Software Foundation may publish revised and/or new+versions of the Lesser General Public License from time to time.+Such new versions will be similar in spirit to the present version,+but may differ in detail to address new problems or concerns.++Each version is given a distinguishing version number.  If the Library+specifies a version number of this License which applies to it and+"any later version", you have the option of following the terms and+conditions either of that version or of any later version published by+the Free Software Foundation.  If the Library does not specify a+license version number, you may choose any version ever published by+the Free Software Foundation.++  14. If you wish to incorporate parts of the Library into other free+programs whose distribution conditions are incompatible with these,+write to the author to ask for permission.  For software which is+copyrighted by the Free Software Foundation, write to the Free+Software Foundation; we sometimes make exceptions for this.  Our+decision will be guided by the two goals of preserving the free status+of all derivatives of our free software and of promoting the sharing+and reuse of software generally.++			    NO WARRANTY++  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO+WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.+EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR+OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY+KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE+LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME+THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN+WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY+AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU+FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR+CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE+LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A+FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH+DAMAGES.++		     END OF TERMS AND CONDITIONS++           How to Apply These Terms to Your New Libraries++  If you develop a new library, and you want it to be of the greatest+possible use to the public, we recommend making it free software that+everyone can redistribute and change.  You can do so by permitting+redistribution under these terms (or, alternatively, under the terms of the+ordinary General Public License).++  To apply these terms, attach the following notices to the library.  It is+safest to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least the+"copyright" line and a pointer to where the full notice is found.++    <one line to give the library's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This library is free software; you can redistribute it and/or+    modify it under the terms of the GNU Lesser General Public+    License as published by the Free Software Foundation; either+    version 2.1 of the License, or (at your option) any later version.++    This library 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+    Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General Public+    License along with this library; if not, write to the Free Software+    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA++Also add information on how to contact you by electronic and paper mail.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the library, if+necessary.  Here is a sample; alter the names:++  Yoyodyne, Inc., hereby disclaims all copyright interest in the+  library `Frob' (a library for tweaking knobs) written by James Random Hacker.++  <signature of Ty Coon>, 1 April 1990+  Ty Coon, President of Vice++That's all there is to it!
@@ -0,0 +1,18 @@+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++    This library is free software; you can redistribute it and/or+    modify it under the terms of the GNU Lesser General Public+    License as published by the Free Software Foundation; either+    version 2.1 of the License, or (at your option) any later version.++    This library 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+    Lesser General Public License for more details.++    You should have received a copy of the GNU Lesser General Public+    License along with this library; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA++Please see COPYING for the license.+
+ Data/ByteString/Lazy/UTF8/Unified.hs view
@@ -0,0 +1,96 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# OPTIONS_HADDOCK ignore-exports, prune #-}++-- | This module unifies some parts of @bytestring@ (as is in @0.9.1.5@+-- version) and @utf8-string@ (as is in @0.3.6@ version) packages - it+-- exports "Data.ByteString.Lazy.Char8", "Data.ByteString.Lazy.UTF8" and+-- "System.IO.UTF8", while hiding from the first everything that is+-- to be found in latter two. Ofcourse "System.IO.UTF8" routines+-- are wrapped to work with lazy 'ByteStrings' instead of 'Strings'.+-- This way we get a module an "Data.ByteString.Lazy.Char8" alternative+-- that won't corrupt Unicode symbols, an that will make+-- a proper IO with them.+--+-- This module is intended to be imported qualified, to avoid name+-- clashes with Prelude functions. eg.+--+-- @import qualified Data.ByteString.Lazy.UTF8.Unified as B@+--+-- or even+--+-- > import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+-- > import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+module Data.ByteString.Lazy.UTF8.Unified (+          module Data.ByteString.Lazy.Char8+        , module Data.ByteString.Lazy.UTF8+        , pack+        , unpack+        , Data.ByteString.Lazy.UTF8.Unified.length+        , putStr+        , putStrLn+        , readFile+        , writeFile+        , appendFile+        , interact+        , getContents+        , hGetContents+        ) where++import Control.Monad+import Data.Int+import Data.ByteString.Lazy.UTF8 hiding (length)+import qualified Data.ByteString.Lazy.UTF8 as U (length)+import qualified Data.ByteString.Lazy.UTF8 as Lazy (ByteString)+import Data.ByteString.Lazy.Char8 hiding (+          ByteString+        , pack,unpack+        , uncons, splitAt, take, drop, span, break, putStrLn, putStr, foldl, foldr, length, lines -- change them on Data.ByteString.Lazy.UTF8+        , putStr,putStrLn,readFile,writeFile,appendFile,interact,getContents,hGetContents -- change them on System.IO.UTF8+        , hGet,hGetNonBlocking,hPut -- however, there is no analog for these in UTF8+        )+import Prelude hiding (length, putStr, putStrLn, readFile, writeFile, appendFile, interact, getContents)+import qualified System.IO.UTF8 as UIO+import System.IO (Handle)++pack :: String -> Lazy.ByteString+pack = fromString++unpack :: Lazy.ByteString -> String+unpack = toString++length :: Lazy.ByteString -> Int64+length = fromIntegral . U.length++putStr :: Lazy.ByteString -> IO ()+putStr = UIO.putStr . unpack++putStrLn :: Lazy.ByteString -> IO ()+putStrLn = UIO.putStrLn . unpack++readFile :: FilePath -> IO Lazy.ByteString+readFile fp = pack `liftM` UIO.readFile fp++writeFile :: FilePath -> Lazy.ByteString -> IO ()+writeFile fp lbs = UIO.writeFile fp $ unpack lbs++appendFile :: FilePath -> Lazy.ByteString -> IO ()+appendFile fp lbs = UIO.appendFile fp $ unpack lbs++interact :: (Lazy.ByteString -> Lazy.ByteString) -> IO ()+interact f = UIO.interact (\ s -> unpack $ f $ pack s)++getContents :: IO Lazy.ByteString+getContents = pack `liftM` UIO.getContents++hGetContents :: Handle -> IO Lazy.ByteString+hGetContents h = pack `liftM` UIO.hGetContents h
+ Data/MyHelpers.hs view
@@ -0,0 +1,304 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT++-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++module Data.MyHelpers where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString) -- this strange act is for backward compatibility with already written code+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)++import Data.Char+import Data.Int+import Data.List+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.Maybe++import Prelude hiding (putStrLn)+import System.IO hiding (putStrLn,hPutStr)+import System.IO.Unsafe++import System.IO.UTF8++----------------------------------++type ErrorMessage = String++infixr 1 <<+(<<)   :: Monad m => m b -> m a -> m b+f << x = x >> f++fst3  :: (a,b,c) -> a+snd3  :: (a,b,c) -> b+thrd3 :: (a,b,c) -> c+fst3  (a,_,_) = a+snd3  (_,b,_) = b+thrd3 (_,_,c) = c++apFor2ple :: (a -> a -> a, b -> b -> b) -> (a,b) -> (a,b) -> (a,b)+apFor2ple (af,bf) (a1,b1) (a2,b2) = (af a1 a2, bf b1 b2)++liftTuple :: Monad m => (m a, m b) -> m (a, b)+lift2ple  :: Monad m => (m a, m b) -> m (a, b)+lift3ple  :: Monad m => (m a, m b, m c) -> m (a, b, c)+lift4ple  :: Monad m => (m a, m b, m c, m d) -> m (a, b, c, d)+liftTuple (ma, mb) = do a <- ma+                        b <- mb+                        return (a,b)+lift2ple = liftTuple+lift3ple (ma, mb, mc) = do a <- ma+                           b <- mb+                           c <- mc+                           return (a,b,c)+lift4ple (ma, mb, mc, md) = do a <- ma+                               b <- mb+                               c <- mc+                               d <- md+                               return (a,b,c,d)++ap22ple :: (a, a)       -> (a -> b) -> (b, b)+ap22ple (a1,a2) fa = (fa a1, fa a2)+ap22pleM :: Monad m => (a, a)       -> (a -> m b) -> m (b, b)+ap22pleM ple f = lift2ple $ ap22ple ple f+ap23ple :: (a, a, a)    -> (a -> b) -> (b, b, b)+ap23ple (a1,a2,a3) fa = (fa a1, fa a2, fa a3)+ap23pleM :: Monad m => (a, a, a)    -> (a -> m b) -> m (b, b, b)+ap23pleM ple f = lift3ple $ ap23ple ple f+ap24ple :: (a, a, a, a) -> (a -> b) -> (b, b, b, b)+ap24ple (a1,a2,a3,a4) fa = (fa a1, fa a2, fa a3, fa a3)+ap24pleM :: Monad m => (a, a, a, a) -> (a -> m b) -> m (b, b, b, b)+ap24pleM ple f = lift4ple $ ap24ple ple f++apFrom2ple :: ((a -> b), (a -> c)) -> a -> (b, c)+apFrom2ple (f1,f2) a = (f1 a, f2 a)+apFrom3ple :: ((a -> b), (a -> c), (a -> d)) -> a -> (b, c, d)+apFrom3ple (f1,f2,f3) a = (f1 a, f2 a, f3 a)+apFrom4ple :: ((a -> b), (a -> c), (a -> d), (a -> e)) -> a -> (b, c, d, e)+apFrom4ple (f1,f2,f3,f4) a = (f1 a, f2 a, f3 a, f4 a)++liftEither6 :: Either er a -> Either er b -> Either er c -> Either er d -> Either er e -> Either er f -> Either er (a,b,c,d,e,f)+liftEither6 er_or_a er_or_b er_or_c er_or_d er_or_e er_or_f =+        case er_or_a of+            Left er -> Left er+            Right a ->+               case er_or_b of+                   Left er -> Left er+                   Right b ->+                        case er_or_c of+                            Left er -> Left er+                            Right c ->+                               case er_or_d of+                                   Left er -> Left er+                                   Right d ->+                                        case er_or_e of+                                            Left er -> Left er+                                            Right e ->+                                               case er_or_f of+                                                   Left er -> Left er+                                                   Right f -> Right (a,b,c,d,e,f)++liftEither5 :: Either er a -> Either er b -> Either er c -> Either er d -> Either er e -> Either er (a,b,c,d,e)+liftEither5 er_or_a er_or_b er_or_c er_or_d er_or_e =+        case er_or_a of+            Left er -> Left er+            Right a ->+               case er_or_b of+                   Left er -> Left er+                   Right b ->+                        case er_or_c of+                            Left er -> Left er+                            Right c ->+                               case er_or_d of+                                   Left er -> Left er+                                   Right d ->+                                        case er_or_e of+                                            Left er -> Left er+                                            Right e -> Right (a,b,c,d,e)++liftEither2 :: Either er a -> Either er b -> Either er (a,b)+liftEither2 er_or_a er_or_b  =+        case er_or_a of+            Left er -> Left er+            Right a ->+               case er_or_b of+                   Left er -> Left er+                   Right b -> Right (a,b)++isLeft :: Either a b -> Bool+isLeft (Left _) = True+isLeft _ = False++isRight :: Either a b -> Bool+isRight = not . isLeft++fromLeft :: Either a b -> a+fromLeft (Left a) = a+fromLeft _ = error "Error occurred, when applied fromLeft to Right!"++fromRight :: Either a b -> b+fromRight (Right b) = b+fromRight _ = error "Error occurred, when applied fromLeft to Right!"++takeFromMap :: Ord k => k -> Map k a -> (Maybe a, Map k a)+takeFromMap k m =+        let mb_a = M.lookup k m+         in ( mb_a+            , case isJust mb_a of+                  True  -> M.delete k m+                  False -> m+            )++partition_2 :: Ord k => (a -> Bool) -> (a -> b, a -> c) -> Map k a -> (Map k b, Map k c)+partition_2 p (true_f, false_f) m =+        M.foldWithKey+                (\ k a (true_map, false_map) ->+                        case p a of+                            True  -> (M.insert k (true_f a) true_map, false_map)+                            False -> (true_map, M.insert k (false_f a) false_map)+                )+                (M.empty, M.empty)+                m++unionWithKey_2 :: Ord k => (k -> (a, a) -> (a, b)) -> (b -> c -> c) -> c -> Map k a -> Map k a -> (Map k a, c)+unionWithKey_2 unifier side_result_accum_f accum_start m1 m2 =+        foldr (\ (k, a1) (m_accum, side_result_accum) ->+                        case takeFromMap k m_accum of+                            (Nothing, _) -> (M.insert k a1 m_accum, side_result_accum)+                            (Just a2, rest_of_accum_map) ->+                                    let (ar, side_result_add) = unifier k (a1, a2)+                                     in (M.insert k ar rest_of_accum_map, side_result_accum_f side_result_add side_result_accum)+              )+              (m2, accum_start)+              (M.toList m1)++unionWithKey_3 :: Ord k => (k -> (Maybe a, Maybe b) -> (c, d)) -> (d -> d -> d) -> d -> Map k a -> Map k b -> (Map k c, d)+unionWithKey_3 unifierF sideResultAccumF accum_start m1 m2 =+        let (m1_result, accum1, m2_cut) = foldr+                      (\ (k, a) (m_accum, side_result_accum, m2_cut) ->+                                let (mb_b, new_m2_cut) = takeFromMap k m2_cut+                                    (c, d) = unifierF k (Just a, mb_b)+                                    new_side_result_accum = sideResultAccumF side_result_accum d+                                 in (M.insert k c m_accum, new_side_result_accum, new_m2_cut)+                      )+                      (M.empty, accum_start, m2)+                      (M.toList m1)+            (m2_result, accum2) = foldr+                      (\ (k, b) (m_accum, side_result_accum) ->+                                let (c, d) = unifierF k (Nothing, Just b)+                                    new_side_result_accum = sideResultAccumF side_result_accum d+                                 in (M.insert k c m_accum, new_side_result_accum)+                      )+                      (m1_result, accum1)+                      (M.toList m2_cut)+         in (m2_result, accum2)++unionWithKey_4 :: Ord k => (k -> (Maybe a, Maybe b) -> (Maybe c, d)) -> (d -> d -> d) -> d -> Map k a -> Map k b -> (Map k c, d)+unionWithKey_4 unifierF sideResultAccumF accum_start m1 m2 =+        let (m1_result, accum1, m2_cut) = foldr+                      (\ (k, a) (m_accum, side_result_accum, m2_cut) ->+                                let (mb_b, new_m2_cut) = takeFromMap k m2_cut+                                    (mb_c, d) = unifierF k (Just a, mb_b)+                                    new_side_result_accum = sideResultAccumF side_result_accum d+                                 in ( case mb_c of+                                          Just c -> M.insert k c m_accum+                                          Nothing -> m_accum+                                    , new_side_result_accum, new_m2_cut+                                    )+                      )+                      (M.empty, accum_start, m2)+                      (M.toList m1)+            (m2_result, accum2) = foldr+                      (\ (k, b) (m_accum, side_result_accum) ->+                                let (mb_c, d) = unifierF k (Nothing, Just b)+                                    new_side_result_accum = sideResultAccumF side_result_accum d+                                 in ( case mb_c of+                                          Just c -> M.insert k c m_accum+                                          Nothing -> m_accum+                                    , new_side_result_accum+                                    )+                      )+                      (m1_result, accum1)+                      (M.toList m2_cut)+         in (m2_result, accum2)++lookupDeleteFromList :: Eq a => a -> [a] -> (Bool, [a])+lookupDeleteFromList e l =+        let mship = elem e l+         in ( mship+            , case mship of+                  True  -> delete e l+                  False -> l+            )++from2DList :: Ord k => [(k, a)] -> M.Map k [a]+from2DList l = foldl (\ accum_map (k, e) -> M.unionWith (++) accum_map (M.singleton k [e])) M.empty l++str2Numeric :: (Num a, Ord a) => String -> Maybe a+str2Numeric s = _str2Numeric s 0+      where+        _str2Numeric []      i              = Just i+        _str2Numeric (sh:st) i | isDigit sh = let nexti = (i*10) + (fromIntegral $ digitToInt sh)+                                               in case i > nexti  of+                                                      False -> _str2Numeric st nexti+                                                      True  -> Nothing+                               | otherwise  = Nothing++cons2' :: Char -> Char -> Lazy.ByteString -> Lazy.ByteString+cons2' c1 c2 s = B.cons' c1 (B.cons' c2 s)++cons3' :: Char -> Char -> Char -> Lazy.ByteString -> Lazy.ByteString+cons3' c1 c2 c3 s = B.cons' c1 (cons2' c2 c3 s)++truncLiterary :: String -> Int -> String+truncLiterary str n = case length str > n of+                          True  -> take (n - 3) str ++ "..."+                          False -> str++truncLiteraryLBS :: Lazy.ByteString -> Int64 -> Lazy.ByteString+truncLiteraryLBS str n =+        case B.length str > n of+            True  -> B.concat [B.take (n - 3) str, B.pack "..."]+            False -> str++-----------------------------+-- few public helpers++dump :: String -> IO ()+dump a = do+        h <- openFile "./dump.out.hs" AppendMode+        hPutStr h a+        hClose h++watch :: Show a => a -> a+watch a = unsafePerformIO $ do+                putStrLn_paged 22 $ show a+                return a++watchCond :: Show a => Bool -> a -> a+watchCond cond = if cond then watch else id++putStrLn_paged :: Int -> String -> IO ()+putStrLn_paged page_size s = f $ lines s+        where+          f lines_list =+                let (to_print, to_next_itera) = splitAt page_size lines_list+                 in do putStrLn (concat $ intersperse "\n" to_print)+                       case null to_next_itera of+                           True  -> return ()+                           False -> f to_next_itera << hGetChar stdin << putStrLn "\n-------Press any key to continue...-------"++traceShowPaged :: Show a => Int -> a -> b -> b+traceShowPaged n a b = unsafePerformIO $ do+        putStrLn_paged n $ show a+        return b++traceCond :: Show a => Bool -> Int -> a -> b -> b+traceCond cond n a b = if cond then traceShowPaged n a b else b
+ PCLT.cabal view
@@ -0,0 +1,178 @@+Name: PCLT+Synopsis: Extension to Show: templating, catalogizing, languages, parameters, etc.+Description:+        \"PCLT\" is an abbreviation for \"Parametric Composable Localizable +        Templates\" - in fact it should also hold Detalizable. +        Term \"Detailizable content (message)\" in this package +        has a following meaning: some content, representing which +        it is possible to regulate, in how much details it is represented.+        .+        Conceptually, this package is a powerful extension to the well known +        Show class, that (extension) is thought to be embeded in any +        Haskell program, which requires multilanguage support, and/or where +        messages should be detailizable. +        .+        The PCLT catalog consists of:+        .+        * Catalog ID+        .+        * Config, which defines rules and constraints, +        that are used when catalog gets formed, and when it is used +        to generate messages.+        .+        * Tempates of messages, possibly related. Each catalog entry +        is referenced by an ID, and is called \"localizable (in languages) +        template\", while it's localization in concrete language is called+        \"localized (in a languages) template\". +        .+        Each catalog entry (localizable template) consists of +        .+        * ID+        .+        * A requirement to detailization level (to used by reciever of +        representation), which if is not statisfied, the template +        isn't used. +        .+        * A map of localized templates by languages - the different +        translations of one same message. +        .+        Each localized template is a sequence of chunks: +        .+        * plain texts, +        .+        * named parameters placeholders, +        .+        * placeholders for insertion of other template (reference on +        other template, also called composites). +        .+        To make a message one needs to specify +        .+        * a catalog, +        .+        * a language, +        .+        * detailization level to orient on+        .+        * a localizable template ID, +        .+        * a map of parameters together with their values. +        .+        The last two fields (localizable template ID + a map of parameters +        together with their values) is called instaniation (of +        templated message). In the program it wrapped in a PCSI data type.+        .+        A parameter value may be +        .+        * plain text +        .+        * newline +        .+        * nothing+        .+        * a reference to other instaniation (localizable template ID + +        a map of parameters together with their values)+        .+        * a list of other other instaniation+        .+        * a parameter wrapping, where wrapper is an indentation of text +        (N whitespaces insertion after each newline character)+        .+        * a list of parameter values.+        .+        This package comes together with another one - a dependent package +        PCLT-DB (section Database), which provides +        .+        * a (PostgreSQL 8.4) DB structure where to keep/manage data +        used for PCLT catalogs formation, +        .+        * simple interface to read this data in haskell program, and+        .+        * a prototype of a longterm service which regularly updates +        catalog MVar with data from DB.+        .+        IMPORTANT!!! : It is highly recommended to use /ISO 639(3)/ standard +        for language names, since PCLT-DB package is oriented on 3 letters +        (not bigger) language names. Without modifications PCLT-DB won't +        work for bigger (then 3-letters) names.+        .+        ToDo considerations for the next versions:+        .+        (0) Consider using state monad in order to put catalog into +        an implicit context... and maybe also other uses if monads.+        .+        (1) Rewrite MakeCatalog, so that it uses CatalogMaths functions. +        Otherwise the both modules do similar work, and keeping double +        code is a bad style.+        .+        (2) Introduction of a new parameter value type: \"reparsable\" +        wrapping for parameter value.+        .+        (3) CatalogMaths extension.+        .+        (4) Enchance required SDLs with min & max functions.+        .+        (5) Sacrificing ldtSubcompositesMap of LocalizedTemplate, +        which initially was introduced to enchance speed of messages +        generation, in favor of making catalogs easier to modify +        (which curently isn't supported and isn't an easy task).+Version: 0.1+Copyright: Copyright (c) 2009 Andrejs Sisojevs+License: LGPL+License-File: COPYRIGHT+Author: Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>+Maintainer: Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>+Stability: alpha+Homepage: http://github.com/Andrey-Sisoyev/PCLT+Category: Text+Tested-With: GHC == 6.10.4+Cabal-Version: >= 1.6+Build-Type: Simple++Extra-Source-Files:+    COPYRIGHT+    COPYING+    doinst.sh+    models/PCLT.BriefModulesStructure.odg+    models/PCLT.BriefModulesStructure.odg.png+    initial_data/PCLT.PCLTCatalog.ods+    examples/HelloWorld/HelloWorld.hs+    examples/HelloWorld/HelloWorld.NoPCLT.hs+    examples/HelloWorld/HelloWorld.PCLTCatalog.ods +Library+    Build-Depends:+        base >= 4 && < 5, bytestring, containers, mtl, utf8-string +    Exposed-Modules:+        Data.ByteString.Lazy.UTF8.Unified+        Text.ConstraintedLBS+        Text.PCLT+        Text.PCLT.Parser.AdvancedSepBy+        Text.PCLT.CommonTypes+        Text.PCLT.Catalog+        Text.PCLT.Catalog__+        Text.PCLT.CatalogMaths+        Text.PCLT.CatalogMaths__+        Text.PCLT.Config+        Text.PCLT.HasStaticRawPCLTs+        Text.PCLT.InitialDefaultCatalog+        Text.PCLT.MakeCatalog+        Text.PCLT.MakeCatalog__+        Text.PCLT.MakeMessage+        Text.PCLT.MakeMessage2+        Text.PCLT.MakeMessage__+        Text.PCLT.SDL+        Text.PCLT.SDL__+        Text.PCLT.PCSI+        Text.PCLT.ShowAsPCSI+        Text.PCLT.ShowAsPCSI__+        Text.PCLT.Template+        Text.PCLT.Template__+        Text.PCLT.CatalogFromHSRT+        Text.PCLT.CatalogFromHSRT__+        Text.PCLT.SH__+    Other-Modules:+        Data.MyHelpers+        Text.PCLT.Parser.ParserInternals+    Extensions:+        BangPatterns, UnboxedTuples, DeriveDataTypeable, ScopedTypeVariables+    ghc-options:+        -funbox-strict-fields
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runghc++import Distribution.Simple+main = defaultMain
+ Text/ConstraintedLBS.hs view
@@ -0,0 +1,148 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- |The analogue to ordinary lazy 'ByteString', but with a constraint on size,+-- and some routines, thet respects the constraint.+module Text.ConstraintedLBS where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import Data.Int+import Data.List+import Data.MyHelpers+import System.IO.Unsafe+import Text.PCLT.Parser.AdvancedSepBy (insertInsteadOf_inLBS)++-- |The analogue to ordinary lazy 'ByteString', but with a constraint on size.+data CLBS = CLBS {+                  clbsLBS            :: Lazy.ByteString+                , clbsLen            :: Int64+                , clbsMaxLen         :: Int64+                -- | Bytestring is finalized, when something is appended to it,+                -- that makes @clbsMaxLen@ to be reached. The last 3 bytes+                -- of a finalized bytestring are always made \"...\"+                -- (by routines of this module, that manage finalization).+                , clbsFinalized_isit :: Bool+                }++clbsFreeSpaceLeft :: CLBS -> Int64+clbsFreeSpaceLeft clbs =+        case clbsFinalized_isit clbs of+            True  -> 0+            False -> clbsMaxLen clbs - clbsLen clbs++-- | Make a 'CLBS' with a specified maximum on length.+newCLBS :: Int64 -> CLBS+newCLBS sp_av = CLBS {+                    clbsLBS            = B.empty+                  , clbsLen            = 0+                  , clbsMaxLen         = sp_av+                  , clbsFinalized_isit = False+                  }++-- | Append first lazy 'ByteString' (given in tuple with+-- it's (trusted) length) to a 'CLBS'. If the result of appending+-- violates clbsMaxLen constraint, then the content gets truncated,+-- tailed with \"...\" and CLBS is finalized (nothing more can be added to it)+addToCLBS_1 :: (Lazy.ByteString, Int64) -> CLBS -> CLBS+addToCLBS_1 add clbs =+        case clbsFinalized_isit clbs of+            True  -> clbs+            False ->+                let (new_lbs, new_len, finalizsed_isit) = concatTruncedLiteraryLBS (apFrom2ple (clbsLBS, clbsLen) clbs) add (clbsFreeSpaceLeft clbs)+                 in clbs { clbsLBS            = new_lbs+                         , clbsLen            = new_len+                         , clbsFinalized_isit = finalizsed_isit+                         }++-- | Produce an empty 'CLBS', that would have the maximum of length equal+-- to free space left available in specified 'CLBS'.+freeSpaceCLBS :: CLBS -> CLBS+freeSpaceCLBS clbs = clbs {+                    clbsLBS    = B.empty+                  , clbsLen    = 0+                  , clbsMaxLen = clbsMaxLen clbs - clbsLen clbs+                  }++-- | Append first to second. If the result of appending+-- violates clbsMaxLen constraint, then the content gets truncated,+-- tailed with \"...\" and CLBS is finalized (nothing more can be added to it)+addToCLBS_2 :: CLBS -> CLBS -> CLBS+addToCLBS_2 add_clbs main_clbs = ((clbsLBS, clbsLen) `apFrom2ple` add_clbs) `addToCLBS_1` main_clbs++-- | Make 'CLBS' contain specified 'ByteString', keeping the length constraint.+-- If the specified bytestring violates clbsMaxLen constraint, then+-- the content gets truncated, tailed with \"...\"+-- and CLBS is finalized (nothing more can be added to it)+adjustCLBS_to :: CLBS -> Lazy.ByteString -> CLBS+adjustCLBS_to clbs new_lbs =+        let new_lbs_len = B.length new_lbs+            max_len     = max 0 (clbsMaxLen clbs)+            tri_p       = B.take (min 3 max_len) (B.pack "...")+         in case new_lbs_len > max_len of+                False -> clbs {+                            clbsLBS = new_lbs+                          , clbsLen = new_lbs_len+                          , clbsFinalized_isit = False+                          }+                True  -> clbs {+                            clbsLBS = B.concat [B.take (max_len - 3) new_lbs, tri_p]+                          , clbsLen = max_len+                          , clbsFinalized_isit = True+                          }++-- | Given @insertInsteadOf_inCLBS (old_separator, new_separator) clbs@,+-- function replaces every occurence of @old_separator@ on @new_separator@+-- respecting length constraint (and possibly finalizing 'CLBS').+insertInsteadOf_inCLBS :: (Lazy.ByteString, Lazy.ByteString) -> CLBS -> CLBS+insertInsteadOf_inCLBS (old_sep, new_sep) clbs =+        let new_lbs = insertInsteadOf_inLBS (old_sep, new_sep) (clbsLBS clbs)+         in clbs `adjustCLBS_to` new_lbs++instance Show CLBS where+        show clbs = B.unpack $ clbsLBS clbs++-- | Empify, and if finalized, make not.+resetCLBS :: CLBS -> CLBS+resetCLBS clbs = clbs { clbsFinalized_isit = False, clbsLen = 0, clbsLBS = B.empty}++-- * Some type aliaces++type StdOut_CLBS = CLBS+type StdErr_CLBS = CLBS+type StdOutAndErr_CLBS = CLBS++-- * Base++----------------------------------------------------------------++-- |Append to first lazy bytestring the second one. The available space+-- for append is constrainted by the 3rd argument. Every bytestring must+-- be specified in tuple together with it's length (this is done to+-- speed up by reducing repeating @length@ calls), which is trusted.+-- If length of added string is bigger then available for append,+-- the result will be truncated and will have a \"...\" tail.+--+-- Function returns resulting ByteString, it's length and boolean indicating+-- if length of added string was bigger than available for append space.+concatTruncedLiteraryLBS :: (Lazy.ByteString, Int64) -> (Lazy.ByteString, Int64) -> Int64 -> (Lazy.ByteString, Int64, Bool)+concatTruncedLiteraryLBS (main_ch, main_len) (add_ch, add_len) _space_for_add =+      let space_for_add = max _space_for_add 0+          tri_p = take (min 3 $ fromIntegral space_for_add) "..."+       in case add_len > space_for_add of+              False -> (B.concat [main_ch, add_ch], main_len + add_len, False)+              True  ->+                 let lbs_list =+                         case space_for_add `compare` 3 of+                             LT -> [B.take (main_len + space_for_add - 3) main_ch                                   ]+                             EQ -> [                                      main_ch                                   ]+                             GT -> [                                      main_ch, B.take (space_for_add - 3) add_ch]+                  in (B.concat (lbs_list ++ [B.pack tri_p]), main_len + space_for_add, True)
+ Text/PCLT.hs view
@@ -0,0 +1,126 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | This is thought to be imported outside of PCLT package by modules,+-- that use PCLT logics (catalog formation routines and+-- messages generation routines)+--+-- And another briefing on what is PCLT. First is in the top level of+-- Haddock documentation provided for the package.+--+-- _______________+--+-- > export "Text.PCLT.SH__"+--+-- This module provides interfaces to the classes 'ShowAsPCSI' and+-- 'HasStaticRawPCLTs' an all the routines, that usually are used for+-- declaration of their instanitations.+--+-- _______________+--+-- > export "Text.ConstraintedLBS"+--+-- A constrainting (the constraint here is on it's size) wrapper for a+-- lazy 'ByteString' (LBS) - this container is used for messages+-- generated from PCLT templates+--+-- _______________+--+-- > export "Text.PCLT.InitialDefaultCatalog"+--+-- > initDefaultCatalog_3 :: Text.PCLT.Catalog.PCLT_CatalogID -> (StdErr_CLBS, ShowDetalizationLevel, LanguageName) -> (PCLT_Catalog, StdErr_CLBS)+--+-- _______________+--+-- > export "Text.PCLT.Catalog"+--+-- Catalog is a unit with 3 fields: catalog ID, config, and a map by+-- template_IDs of templates, where each template is: minimal SDL required+-- to represent message from this template, and a maps by languages of+-- localized templates.+--+-- _______________+--+-- > export "Text.PCLT.CatalogFromHSRT"+--+-- We want to add to the default catalog some our application specific+-- entries (templates)+--+-- > addFromHSRTToCatalog_2 :: HasStaticRawPCLTs a => a -> PCLT_Catalog -> (StdErr_CLBS, ShowDetalizationLevel, LanguageName) -> (PCLT_Catalog, StdErr_CLBS)+--+-- _______________+--+-- > export "Text.PCLT.CommonTypes"+--+-- Some type aliases, like @'LanguageName' = 'String'@+--+-- _______________+--+-- > export "Text.PCLT.Config"+--+-- Configuration that influences the behaviour of catalog formation routines+-- and messages generation routines.+--+-- _______________+--+-- > export "Text.PCLT.MakeMessage"+--+-- PCSI(template_id + params) + language_name + recepient_SDL + catalog >---(Text.PCLT.MakeMessage)---> message+--+-- _______________+--+-- > export "Text.PCLT.MakeMessage2"+--+-- Some comfort wrappers for "Text.PCLT.MakeMessage"+--+-- _______________+--+-- > export "Text.PCLT.SDL"+--+-- SDL (Show Detalization Level) is a 1-dimensional variable type, built+-- on Int, but extended with additional values:+--+-- @Zero_SDL@ (absolute minimal level) @< One_SDL@ (minimal something) @< SDL Int < InfinitelyBig_SDL@+--+-- With SDL we regulate, how much some Reader (of our generated messages)+-- wishes (is allowed) to see.+--+-- _______________+--+-- > export "Text.PCLT.ShowAsPCSI__"+--+-- Some general instances of 'ShowAsPCSI' class are to be found here+-- (Bool, ShowAsPCSI a => Maybe a, SomeException)+module Text.PCLT (+          module Text.PCLT.SH__+        , module Text.ConstraintedLBS+        , module Text.PCLT.InitialDefaultCatalog+        , module Text.PCLT.Catalog+        , module Text.PCLT.CatalogFromHSRT+        , module Text.PCLT.CommonTypes+        , module Text.PCLT.Config+        , module Text.PCLT.MakeMessage+        , module Text.PCLT.MakeMessage2+        , module Text.PCLT.SDL+        , module Text.PCLT.ShowAsPCSI__+        ) where+-- It's a pitty one can't comment with Haddock on imports...+import           Text.PCLT.SH__+import           Text.ConstraintedLBS+import           Text.PCLT.InitialDefaultCatalog+import           Text.PCLT.Catalog+import           Text.PCLT.CatalogFromHSRT+import           Text.PCLT.CommonTypes+import           Text.PCLT.Config+import           Text.PCLT.MakeMessage+import           Text.PCLT.MakeMessage2+import           Text.PCLT.SDL+import           Text.PCLT.ShowAsPCSI__
+ Text/PCLT/Catalog.hs view
@@ -0,0 +1,66 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++module Text.PCLT.Catalog where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import Data.Int+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.MyHelpers+import Data.Typeable+import Text.PCLT.Config+import Text.PCLT.Template+import Text.PCLT.CommonTypes++type PCLT_CatalogID = Int++data PCLT_Catalog = PCLT_Catalog {+                  pcltcCatalogID   :: PCLT_CatalogID+                , pcltcCatalogMap  :: PCLT_CatalogMap+                -- | It is highly recommended not to change this param+                -- values after catalog is formed, since it's easy to+                -- spoil catalog content that way.+                , pcltcInnerConfig :: PCLT_InnerConfig+                }+     deriving (Show, Typeable)++catInstMaxLen :: PCLT_Catalog -> Int64+catInstMaxLen = pcsInstaniationResultMaxSize . pcltcInnerConfig+catDfltLng :: PCLT_Catalog -> LanguageName+catDfltLng = pcsDefaultLanguage . pcltcInnerConfig+catStrictOrient :: PCLT_Catalog -> StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets+catStrictOrient = pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets . pcltcInnerConfig+catSize :: PCLT_Catalog -> Int+catSize c = M.size $ pcltcCatalogMap c++-----------------------------------------+-- * Common errors related to catalog, used by diffent functions+data TplDefaultLngIsMissing_PCLTE     = TplDefaultLngIsMissing_PCLTE PCLT_CompositeKey               deriving (Show, Typeable)+data DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_PCLTE+                                      = DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_PCLTE PCLT_CompositeKey LanguageName+                                                                                                     deriving (Show, Typeable)+data RequiredCompositeIsMissing_PCLTE = RequiredCompositeIsMissing_PCLTE RequiredCompositeKey        deriving (Show, Typeable)+data RequiredByRequirerCompositeIsMissing_PCLTE+                                      = RequiredByRequirerCompositeIsMissing_PCLTE RequirerCompositeKey RequiredCompositeIsMissing_PCLTE+                                                                                                     deriving (Show, Typeable)+data CompositionCycle_PCLTE           = CompositionCycle_PCLTE PCLT_CompositeKey [PCLT_CompositeKey] deriving (Show, Typeable)+data TplUniquenessViol_PCLTE          = TplUniquenessViol_PCLTE PCLT_ID [LanguageName]               deriving (Show, Typeable)++type MainUnit_SDL  = PCLT_ShowDetalizationLevel+type AddedUnit_SDL = PCLT_ShowDetalizationLevel+data DifferentSDLs_PCLTE              = DifferentSDLs_PCLTE PCLT_ID (MainUnit_SDL, AddedUnit_SDL)    deriving (Show, Typeable)+----+data ErrorWithPCSCatalog            a = ErrorWithPCSCatalog PCLT_CatalogID a                         deriving (Show, Typeable)++-----------------------------------------------------------------+
+ Text/PCLT/CatalogFromHSRT.hs view
@@ -0,0 +1,121 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | Tools to use 'HasStaticRawPCLTs' class instances in order to build up+-- a catalog. (\"FromHSRT\" in module name means "from a given instance of+-- HasStaticRawPCLTs class")+module Text.PCLT.CatalogFromHSRT where++import Control.Monad+import Data.List+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.MyHelpers+import Data.Either+import Data.Typeable+import Text.ConstraintedLBS+import Text.PCLT.Catalog+import Text.PCLT.CatalogMaths+import Text.PCLT.CatalogMaths__+import Text.PCLT.CommonTypes+import Text.PCLT.Config+import Text.PCLT.MakeCatalog+import Text.PCLT.MakeMessage+import Text.PCLT.MakeMessage2+import Text.PCLT.SDL+import Text.PCLT.PCSI+import Text.PCLT.Template+import Text.PCLT.HasStaticRawPCLTs+import Text.PCLT.ShowAsPCSI++------------------------------+-- |+data CatalogFromHSRTInitErrors = CatalogFromHSRTInitErrors {+                  cfhieCatalogID      :: PCLT_CatalogID+                , cfhieCatReadErrs    :: [ErrorWithPCSCatalog ReadPCSCatalogError]+                , cfhieCollectionErrs :: [AddPCLT_toPCLT_Error]+                }+               deriving (Show, Typeable)++defaultCatalogFromHSRTInitErrors :: PCLT_CatalogID -> CatalogFromHSRTInitErrors+defaultCatalogFromHSRTInitErrors cat_id = CatalogFromHSRTInitErrors {+                  cfhieCatalogID      = cat_id+                , cfhieCatReadErrs    = []+                , cfhieCollectionErrs = []+                }++initCatalogFromHSRT :: HasStaticRawPCLTs a => a -> PCLT_InnerConfig -> PCLT_CatalogID -> (PCLT_Catalog, CatalogFromHSRTInitErrors)+initCatalogFromHSRT a inner_cfg cat_id =+        let (raw_cat_input_data, pclt_sum_errs) = getStaticRawPCLTs inner_cfg a+            (catalog, cat_make_errs) = readPCLTCatalog+                                inner_cfg+                                cat_id+                                raw_cat_input_data+         in ( catalog+            , (defaultCatalogFromHSRTInitErrors cat_id) {+                          cfhieCollectionErrs = pclt_sum_errs+                        , cfhieCatReadErrs    = cat_make_errs+              }+            )++-- | A wrapper around 'initCatalogFromHSRT' function.+-- For case, when all errors are to be represented at once.+initCatalogFromHSRT_2 :: HasStaticRawPCLTs a => a -> PCLT_InnerConfig -> PCLT_CatalogID -> (StdErr_CLBS, ShowDetalizationLevel, LanguageName) -> (PCLT_Catalog, StdErr_CLBS)+initCatalogFromHSRT_2 a inner_config cat_id (stderr_clbs, sdl, lng) =+        let (cat, cfhie)  = initCatalogFromHSRT a inner_config cat_id+            errs_arethere = (not $ null $ cfhieCatReadErrs cfhie) || (not $ null $ cfhieCollectionErrs cfhie)+         in (cat, case errs_arethere of+                      True  -> pcsi2text_plus_errs_1 stderr_clbs (showAsPCSI cfhie) (sdl, lng) cat+                      False -> stderr_clbs+            )++------------------------------------------------------------+-- it is defined here, not in "CatalogFromHSRT__", because of recursive module imports restriction... an exclusive case+instance ShowAsPCSI CatalogFromHSRTInitErrors where+        showAsPCSI cfhie =+                thePCSI+                        "E_PCLTC_CFHIE"+                        [ ("pclt_cfhie_err_details", PCSIList_PV err_pcsi_list usualSeparatorInPCSIList)+                        , ("cat_id"               , PlainText_PV $ show $ cfhieCatalogID cfhie)+                        ]+              where+                err_pcsi_rpcsce_l = case cfhieCatReadErrs cfhie of+                                        []            -> []+                                        l             -> [ thePCSI "E_PCLTC_CFHIE_RPCSCE_L"  [("cre_list" , Indented_PV 4 $ PCSIList_PV (map showAsPCSI l) usualSeparatorInPCSIList)] ]+                err_pcsi_cole_l   = case cfhieCollectionErrs cfhie of+                                        []            -> []+                                        l             -> [ thePCSI "E_PCLTC_CFHIE_APTTPTE_L" [("cole_list", Indented_PV 4 $ PCSIList_PV (map showAsPCSI l) usualSeparatorInPCSIList)] ]+                err_pcsi_list     = err_pcsi_cole_l ++ err_pcsi_rpcsce_l+-------------------------------------------------------------++addFromHSRTToCatalog :: HasStaticRawPCLTs a => a -> PCLT_Catalog -> (PCLT_Catalog, CatalogFromHSRTInitErrors)+addFromHSRTToCatalog a catalog =+        let inner_cfg = pcltcInnerConfig catalog+            (raw_input, pclt_sum_errs) = getStaticRawPCLTs inner_cfg a+            (catalog2 , cat_read_errs) = _readPCLTCatalog (catalog, []) raw_input+         in ( catalog2+            , CatalogFromHSRTInitErrors {+                  cfhieCatalogID      = pcltcCatalogID catalog+                , cfhieCatReadErrs    = cat_read_errs+                , cfhieCollectionErrs = pclt_sum_errs+                }+            )++-- | A wrapper around 'addFromHSRTToCatalog' function.+-- For case, when all errors are to be represented at once.+addFromHSRTToCatalog_2 :: HasStaticRawPCLTs a => a -> PCLT_Catalog -> (StdErr_CLBS, ShowDetalizationLevel, LanguageName) -> (PCLT_Catalog, StdErr_CLBS)+addFromHSRTToCatalog_2 a catalog (stderr_clbs, sdl, lng) =+        let (catalog2, cfhie) = addFromHSRTToCatalog a catalog+            errs_arethere = (not $ null $ cfhieCatReadErrs cfhie) || (not $ null $ cfhieCollectionErrs cfhie)+         in (catalog2, case errs_arethere of+                      True  -> pcsi2text_plus_errs_1 stderr_clbs (showAsPCSI cfhie) (sdl, lng) catalog2+                      False -> stderr_clbs+            )
+ Text/PCLT/CatalogFromHSRT__.hs view
@@ -0,0 +1,44 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# OPTIONS_HADDOCK hide #-}++module Text.PCLT.CatalogFromHSRT__ where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Text.PCLT.SH__+import Text.PCLT.CatalogFromHSRT+-------------------------------------------++-- instance ShowAsPCSI CatalogFromHSRTInitErrors  is defined in primary module (Text.PCLT.CatalogFromHSRT)++instance HasStaticRawPCLTs CatalogFromHSRTInitErrors where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLTC_CFHIE", (M.fromList [("rus", B.pack "##|E_PCLTC_CFHIE_PREFIX##| @@|pclt_cfhie_err_details@@|\n##|E_PCLTC_CFHIE_POSTFIX##|"), ("eng", B.pack "##|E_PCLTC_CFHIE_PREFIX##| @@|pclt_cfhie_err_details@@|\n##|E_PCLTC_CFHIE_POSTFIX##|")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLTC_CFHIE_PREFIX", (M.fromList [("rus", B.pack "Произошла одна или несколько ошибок при попытке инициализировать каталог [ИД: @@|cat_id@@|] из данных определённых через воплощение класса \"HasStaticRawPCLTs\": "), ("eng", B.pack "One on more errors occurred when trying to initialize a catalog [ID: @@|cat_id@@|] from an instance of class \"HasStaticRawPCLTs\": ")], str2PCLT_SDL Required_SDLM "##|E_PCLTC_CFHIE##|" inner_cfg))+                        , ("E_PCLTC_CFHIE_APTTPTE_L", (M.fromList [("rus", B.pack "\n ** Ошибки сборки множества шаблонов, из которых необходимо сформировать каталог: @@|cole_list@@|"), ("eng", B.pack "\n ** Errors of collecting templates for catalog formation input: @@|cole_list@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLTC_CFHIE##|" inner_cfg))+                        , ("E_PCLTC_CFHIE_RPCSCE_L", (M.fromList [("rus", B.pack "\n ** Ошибки чтения и формирования образа каталога: @@|cre_list@@|"), ("eng", B.pack "\n ** Catalog parsing errors: @@|cre_list@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLTC_CFHIE##|" inner_cfg))+                        , ("E_PCLTC_CFHIE_POSTFIX", (M.fromList [("rus", B.pack "С упущениями, но всё же каталог (частично) считан."), ("eng", B.pack "Despite of losses, the catalog is (partly) read.")], str2PCLT_SDL Required_SDLM "##|E_PCLTC_CFHIE##|" inner_cfg))+                        ]++--------------------------------------------------------------------------------------+--------------------------------------------------------------------------------------++data PCLTRawCatalog__Text_PCLT_CatalogFromHSRT = PCLTRawCatalog__Text_PCLT_CatalogFromHSRT+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_CatalogFromHSRT where+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                                [ getStaticRawPCLTs inner_cfg (undefined :: CatalogFromHSRTInitErrors) ]
+ Text/PCLT/CatalogMaths.hs view
@@ -0,0 +1,96 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | Functions from this module isn't used for catalog formation.+-- It's not very wise to have two similar codes of catalog maths here and+-- in module "Text.PCLT.MakeCatalog", since it raises double maintenence+-- problem. Perhaps the problem will be solved in future versions.+--+-- The math's errors, however, seems to be of use in other modules.+module Text.PCLT.CatalogMaths where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import Data.Char+import Data.List+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.Maybe+import Data.MyHelpers+import Data.Word+import Data.Typeable+import Text.ConstraintedLBS+import Text.PCLT.Catalog+import Text.PCLT.Config+import Text.PCLT.CommonTypes+import Text.PCLT.MakeCatalog+import Text.PCLT.SDL+import Text.PCLT.Template++----------------------------------------------------------------------------------------------------------------+-- | Error type for 'addLngTpl_toPCLT'.+data AddLngTpl_toPCLT_Error =+          TplUniquenessViol_APSTPTE TplUniquenessViol_PCLTE+        | DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_APSTPTE DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_PCLTE+      deriving (Show, Typeable)++-- | Adds localized template as a special case of localizable template.+addLngTpl_toPCLT :: PCLT_ID -> (LanguageName, LocalizedTemplate) -> LocalizableTemplate -> PCLT_InnerConfig -> (LocalizableTemplate, [AddLngTpl_toPCLT_Error])+addLngTpl_toPCLT tpl_id (lng, ldt) pclt cfg =+        let dflt_lng = pcsDefaultLanguage cfg+            so = pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets cfg+            aswas_ldt_lng_map = pcltLocalizationsMap pclt+            dltcpsdfoon_err _tpl_id _lng = DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_APSTPTE $ DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_PCLTE _tpl_id _lng+         in case M.member lng aswas_ldt_lng_map of+                True  -> (pclt, [TplUniquenessViol_APSTPTE $ TplUniquenessViol_PCLTE tpl_id [lng]])+                False ->+                     let (mb_dflt_ldt, ldt_lng_map_tocheck, ldt_lng_map_tostay) =+                             case lng == dflt_lng of+                                 True  -> (Just ldt, aswas_ldt_lng_map, M.empty)+                                 False ->+                                      let (mb_dfltlng_ldt, left_to_stay) = takeFromMap dflt_lng aswas_ldt_lng_map+                                       in ( mb_dfltlng_ldt+                                          , M.singleton lng ldt+                                          , left_to_stay+                                          )+                      in case mb_dflt_ldt of+                             Nothing -> (pclt { pcltLocalizationsMap = M.union ldt_lng_map_tocheck ldt_lng_map_tostay } , [])+                             Just dflt_ldt ->+                                        foldr+                                          (\ (lng, ldt) (pclt_accum, errs_accum) ->+                                                case compareStrictOrientationOnDefault tpl_id so ldt dflt_ldt of+                                                    True  -> (pclt_accum { pcltLocalizationsMap = M.insert lng ldt (pcltLocalizationsMap pclt_accum) }, errs_accum )+                                                    False -> (pclt_accum , dltcpsdfoon_err tpl_id lng : errs_accum )+                                          )+                                          (pclt { pcltLocalizationsMap = M.insert dflt_lng dflt_ldt ldt_lng_map_tostay }, [])+                                          (M.toList ldt_lng_map_tocheck)++-- | Error type for 'addPCLT_toPCLT'.+data AddPCLT_toPCLT_Error =+          AddLngTpl_toPCLT_Error_APTTPTE AddLngTpl_toPCLT_Error+        | DifferentSDLs_APTTPTE DifferentSDLs_PCLTE+       deriving (Show, Typeable)++-- | Adds up localizable templates, their localized cases.+addPCLT_toPCLT :: PCLT_ID -> LocalizableTemplate -> LocalizableTemplate -> PCLT_InnerConfig -> (LocalizableTemplate, [AddPCLT_toPCLT_Error])+addPCLT_toPCLT tpl_id add_pclt main_pclt cfg =+        foldr (\ (lng, added_ldt) (main_pclt_accum, errs_accum) ->+                        let (new_pclt_accum, new_errs) = addLngTpl_toPCLT tpl_id (lng, added_ldt) main_pclt_accum cfg+                         in (new_pclt_accum, map AddLngTpl_toPCLT_Error_APTTPTE new_errs ++ errs_accum)+              )+              ( main_pclt+              , let sdls@(main_sdl, add_sdl) = (pcltRequiredSDL main_pclt, pcltRequiredSDL add_pclt)+                 in case add_sdl == main_sdl of+                        True  -> []+                        False -> [DifferentSDLs_APTTPTE $ DifferentSDLs_PCLTE tpl_id sdls]+              )+              (M.toList $ pcltLocalizationsMap add_pclt)+
+ Text/PCLT/CatalogMaths__.hs view
@@ -0,0 +1,87 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# OPTIONS_HADDOCK hide #-}++module Text.PCLT.CatalogMaths__ where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.MyHelpers+import Text.PCLT.SH__+import Text.PCLT.CatalogMaths+import Text.PCLT.Catalog__+import Text.PCLT.SDL__+import Text.PCLT.Template__++----------------------------------------++instance ShowAsPCSI AddLngTpl_toPCLT_Error where+        showAsPCSI apstpte = thePCSI "E_PCLT_APSTPTE" [("pclt_apstpte_err_details", PCSI_PV err_pcsi)]+          where+            err_pcsi =+                case apstpte of+                    TplUniquenessViol_APSTPTE tuv ->+                            addToPCSI+                                [showAsPCSI tuv]+                                (   empPCSI "E_PCLT_APSTPTE_TPLUNQVIOL")+                    DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_APSTPTE dltcpsdfoon ->+                            addToPCSI+                                [showAsPCSI dltcpsdfoon]+                                (   empPCSI "E_PCLT_APSTPTE_DLTCPSDFOON")++instance HasStaticRawPCLTs AddLngTpl_toPCLT_Error where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLT_APSTPTE", (M.fromList [("rus", B.pack "##|E_PCLT_APSTPTE_PREFIX##|@@|pclt_apstpte_err_details@@|."), ("eng", B.pack "##|E_PCLT_APSTPTE_PREFIX##|@@|pclt_apstpte_err_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_APSTPTE_PREFIX", (M.fromList [("rus", B.pack "Произошла ошибка при прибавлен локализованой версии шаблона к локализуемому шаблону: "), ("eng", B.pack "An error occured when adding a localized template version to localizable template:")], str2PCLT_SDL Required_SDLM "##|E_PCLT_APSTPTE##|" inner_cfg))+                        , ("E_PCLT_APSTPTE_TPLUNQVIOL", (M.fromList [("rus", B.pack "##|E_PCLT_COMMONS_UNIQUEVIOL##|"), ("eng", B.pack "##|E_PCLT_COMMONS_UNIQUEVIOL##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_APSTPTE##|" inner_cfg))+                        , ("E_PCLT_APSTPTE_DLTCPSDFOON", (M.fromList [("rus", B.pack "##|E_PCLT_COMMONS_DLTCPSDFOON##|"), ("eng", B.pack "##|E_PCLT_COMMONS_DLTCPSDFOON##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_APSTPTE##|" inner_cfg))+                        ]++------------------------------------------------------+instance ShowAsPCSI AddPCLT_toPCLT_Error where+        showAsPCSI apttpte = thePCSI "E_PCLT_APTTPTE" [("pclt_apttpte_err_details", PCSI_PV err_pcsi)]+           where+              err_pcsi =+                case apttpte of+                    AddLngTpl_toPCLT_Error_APTTPTE apstpte ->+                            addToPCSI+                                [showAsPCSI apstpte]+                                (   empPCSI "E_PCLT_APTTPTE_APSTPTE")+                    DifferentSDLs_APTTPTE dsdls ->+                            addToPCSI+                                [showAsPCSI dsdls]+                                (   empPCSI "E_PCLT_APTTPTE_DIFFSDLS")++instance HasStaticRawPCLTs AddPCLT_toPCLT_Error where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLT_APTTPTE", (M.fromList [("rus", B.pack "##|E_PCLT_APTTPTE_PREFIX##|@@|pclt_apttpte_err_details@@|."), ("eng", B.pack "##|E_PCLT_APTTPTE_PREFIX##|@@|pclt_apttpte_err_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_APTTPTE_PREFIX", (M.fromList [("rus", B.pack "Произошла ошибка при слиянии 2-ух наборов локалицаций в один шаблон: "), ("eng", B.pack "An error occured when when merging 2 localizations sets into one templatestructure:")], str2PCLT_SDL Required_SDLM "##|E_PCLT_APTTPTE##|" inner_cfg))+                        , ("E_PCLT_APTTPTE_APSTPTE", (M.fromList [("rus", B.pack "##|E_PCLT_APSTPTE##|"), ("eng", B.pack "##|E_PCLT_APSTPTE##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_APTTPTE##|" inner_cfg))+                        , ("E_PCLT_APTTPTE_DIFFSDLS", (M.fromList [("rus", B.pack "##|E_PCLT_COMMONS_DIFFSDLS##|"), ("eng", B.pack "##|E_PCLT_COMMONS_DIFFSDLS##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_APTTPTE##|" inner_cfg))+                        ]++------------------------------------------------------++data PCLTRawCatalog__Text_PCLT_CatalogMaths = PCLTRawCatalog__Text_PCLT_CatalogMaths+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_CatalogMaths where+     widenessOfStaticRawPCLTsSet _ = Module_RPSW+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                        [ getStaticRawPCLTs inner_cfg (undefined :: AddLngTpl_toPCLT_Error)+                        , getStaticRawPCLTs inner_cfg (undefined :: AddPCLT_toPCLT_Error)+                        ] -- i wish i knew an easy way how to achieve a smaller code of this by using a "map (getStaticRawPCLTs inner_cfg) [...]" function
+ Text/PCLT/Catalog__.hs view
@@ -0,0 +1,86 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# OPTIONS_HADDOCK hide #-}++module Text.PCLT.Catalog__ where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Text.PCLT.SH__+import Text.PCLT.Catalog+import Text.PCLT.Template__++--------------------------------------++instance ShowAsPCSI DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_PCLTE where+        showAsPCSI (DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_PCLTE tpl_id lng) = thePCSI "E_PCLT_COMMONS_DLTCPSDFOON" [("tpl_id", PlainText_PV tpl_id), ("lng", PlainText_PV lng)]+instance ShowAsPCSI TplDefaultLngIsMissing_PCLTE where+        showAsPCSI (TplDefaultLngIsMissing_PCLTE tpl_id) = thePCSI "E_PCLT_COMMONS_TDLIM" [("tpl_id", PlainText_PV tpl_id)]+instance ShowAsPCSI RequiredCompositeIsMissing_PCLTE where+        showAsPCSI (RequiredCompositeIsMissing_PCLTE red_id) = thePCSI "E_PCLT_COMMONS_MISSINGCOMPST" [("red_id", PlainText_PV red_id)]+instance ShowAsPCSI RequiredByRequirerCompositeIsMissing_PCLTE where+        showAsPCSI (RequiredByRequirerCompositeIsMissing_PCLTE rer_id (RequiredCompositeIsMissing_PCLTE red_id)) =+                        thePCSI "E_PCLT_COMMONS_MISSINGCOMPSTBYRER" [("red_id", PlainText_PV red_id), ("rer_id", PlainText_PV rer_id)]+instance ShowAsPCSI CompositionCycle_PCLTE where+        showAsPCSI (CompositionCycle_PCLTE tpl_id buf) = thePCSI "E_PCLT_COMMONS_CCYCL" [("tpl_id", PlainText_PV tpl_id), ("buf", PlainText_PV $ show buf)]+instance ShowAsPCSI TplUniquenessViol_PCLTE where+        showAsPCSI (TplUniquenessViol_PCLTE tpl_id lng_list) = thePCSI "E_PCLT_COMMONS_UNIQUEVIOL" [("tpl_id", PlainText_PV tpl_id), ("lng_list", PlainText_PV $ show lng_list)]+instance ShowAsPCSI DifferentSDLs_PCLTE where+        showAsPCSI (DifferentSDLs_PCLTE tpl_id (main_sdl, add_sdl)) =+                                thePCSI "E_PCLT_COMMONS_DIFFSDLS"+                                            [ ("tpl_id"  , PlainText_PV tpl_id)+                                            , ("main_sdl", PCSI_PV $ showAsPCSI main_sdl)+                                            , ("add_sdl" , PCSI_PV $ showAsPCSI add_sdl)+                                            ]++data PCLTRawCatalog__Text_PCLT_PCLTCommons = PCLTRawCatalog__Text_PCLT_PCLTCommons+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_PCLTCommons where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLT_COMMONS_CCYCL", (M.fromList [("rus",  B.pack "обнаружен композиционный цикл в шаблоне сообщения (ИД: @@|tpl_id@@|), буфер композиций: @@|buf@@|"), ("eng",  B.pack "a composition cycle detected in a message template (ID: @@|tpl_id@@|), compositions path buffer: @@|buf@@|")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_COMMONS_MISSINGCOMPST", (M.fromList [("rus",  B.pack "композит (ИД: @@|red_id@@|) в каталоге отсутствует"), ("eng",  B.pack "a composite (ID: @@|red_id@@|) is missing in catalog")], str2PCLT_SDL Required_SDLM "##|E_PCLT_COMMONS_CCYCL##|" inner_cfg))+                        , ("E_PCLT_COMMONS_MISSINGCOMPSTBYRER", (M.fromList [("rus",  B.pack "##|E_PCLT_COMMONS_MISSINGCOMPST##|. На недостающий композит ссылается шаблон (ИД: @@|rer_id@@|)"), ("eng",  B.pack "##|E_PCLT_COMMONS_MISSINGCOMPST##|. The missing composite is required by the message template (ID: @@|rer_id@@|)")], str2PCLT_SDL Required_SDLM "##|E_PCLT_COMMONS_CCYCL##|" inner_cfg))+                        , ("E_PCLT_COMMONS_TDLIM", (M.fromList [("rus",  B.pack "шаблон (ИД: @@|tpl_id@@|) на основном языке не дан, но дан для др. языков. ДЛЯ ВСЕХ ЯЗЫКОВ данный шаблон будет отвергнут"), ("eng",  B.pack "A message template (ID: @@|tpl_id@@|) in default language is missing (while persisting for other languages). FOR ALL LANGUAGES the message template will be discarded")], str2PCLT_SDL Required_SDLM "##|E_PCLT_COMMONS_CCYCL##|" inner_cfg))+                        , ("E_PCLT_COMMONS_DLTCPSDFOON", (M.fromList [("rus", B.pack "шаблон (ИД: @@|tpl_id@@|) - его множества параметров и композитов отличаются для основного языка и для НЕосновного языка «@@|lng@@|». Версия шаблона на НЕосновном языке отвергнута (если такая строгость вас неустраивает, подрегулируйте параметр <StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets> в конфигурации каталога)"), ("eng", B.pack "A message template's (ID: @@|tpl_id@@|) sets of subcomposites and parameters differs for default and nondefault languages ('@@|lng@@|'). The template version for this nondefault language WILL BE DISCARDED (if such strictness doesn't fit your needs, change catalog configuration parameter <StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets>)")], str2PCLT_SDL Required_SDLM "##|E_PCLT_COMMONS_CCYCL##|" inner_cfg))+                        , ("E_PCLT_COMMONS_UNIQUEVIOL", (M.fromList [("rus", B.pack "в локализуемом шаблоне (ИД: @@|tpl_id@@|), уже присутствует версия на языках @@|lng_list@@|, - языковые версии шаблона на этих языках добавить нельзя (не выкинув старые версии)"), ("eng", B.pack "the localizeble template (ID: @@|tpl_id@@|) is already localized in languages @@|lng_list@@|, - new localizations' versions can't be added (without throwing away old ones)")], str2PCLT_SDL Required_SDLM "##|E_PCLT_COMMONS_CCYCL##|" inner_cfg))+                        , ("E_PCLT_COMMONS_DIFFSDLS", (M.fromList [("rus", B.pack "при сложении локализуемых шаблонов (ИД: @@|tpl_id@@|) обнаружено расхождение в их требованиях к уровню детализации необходимому для отображения. Требуемые уровни (прибавляемы шаблоном / шаблоном аккумулятором): @@|add_sdl@@|/@@|main_sdl@@|"), ("eng", B.pack "when adding up two localizables of one ID (\"@@|tpl_id@@|\") an inconsistency shows up - required show-detalization-levels differs for them. Required levels (of added tpl / of accumulator tpl): @@|add_sdl@@|/@@|main_sdl@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_COMMONS_CCYCL##|" inner_cfg))+                        ]++instance ShowAsPCSI a => ShowAsPCSI (ErrorWithPCSCatalog a) where+        showAsPCSI (ErrorWithPCSCatalog cat_id pclt_wpcsc_err_details) =+                thePCSI "E_PCSC"+                            [ ("cat_id", PlainText_PV $ show cat_id)+                            , ("pclt_wpcsc_err_details", PCSI_PV $ showAsPCSI pclt_wpcsc_err_details)+                            ]++data PCLTRawCatalog__Text_PCLT_ErrorWithPCSCatalog = PCLTRawCatalog__Text_PCLT_ErrorWithPCSCatalog+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_ErrorWithPCSCatalog where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCSC", (M.fromList [("rus", B.pack "##|E_PCLTC_PREFIX##| @@|pclt_wpcsc_err_details@@|"), ("eng", B.pack "##|E_PCLTC_PREFIX##| @@|pclt_wpcsc_err_details@@|")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLTC_PREFIX", (M.fromList [("rus", B.pack "Произошла ошибка в связи с каталогом [ИД: @@|cat_id@@|] шаблонов стандартных локализуемых детализуемых сообщений. "), ("eng", B.pack "An error occured in context of messages templates catalog [ID: @@|cat_id@@|].")], str2PCLT_SDL Required_SDLM "##|E_PCSC##|" inner_cfg))+                        ]++------------------------------------------------------------------------------++data PCLTRawCatalog__Text_PCLT_Catalog = PCLTRawCatalog__Text_PCLT_Catalog+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_Catalog where+     widenessOfStaticRawPCLTsSet _ = Module_RPSW+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                        [ getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_PCLTCommons)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_ErrorWithPCSCatalog)+                        ] -- i wish i knew an easy way how to achieve a smaller code of this by using a "map (getStaticRawPCLTs inner_cfg) [...]" function
+ Text/PCLT/CommonTypes.hs view
@@ -0,0 +1,34 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++module Text.PCLT.CommonTypes where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)++-- | It is highly recommended to use /ISO 639-3/ here - I mean+-- it was originally intended to do so, and now a related package PCLT-DB+-- works only with 3-letters (not bigger) languages names -+-- there is a constraint in DB for that.+type LanguageName = String++type PCLT_ID                = String+-- | Localizable template ID.+type PCLT_ParamKey          = String+-- | Here and in many places of package by+-- \"composite\" is meant \"template which is included in+-- composed template\".+type PCLT_CompositeKey      = PCLT_ID+type PCLT_SuperCompositeKey = PCLT_CompositeKey+type PCLT_SubCompositeKey   = PCLT_CompositeKey+type RequiredCompositeKey   = PCLT_CompositeKey+type RequirerCompositeKey   = PCLT_CompositeKey++type ParamName_LBS = Lazy.ByteString
+ Text/PCLT/Config.hs view
@@ -0,0 +1,252 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++module Text.PCLT.Config where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import Data.Int+import Text.PCLT.CommonTypes+import Data.Typeable++----------------------------------------------+data StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets =+        StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets {+                  -- | Abbreviation = \"SO\". The exclusions has opposite+                  -- roles for different values of this parameter.+                  --+                  -- * if SO is True ,       be strict with templates+                  -- (when adding them and to a catalog) in such manner,+                  -- that set of composite and set of parameters MUST be+                  -- the same for ALL language localizations under+                  -- one template ID; if for a template any set (of+                  -- parameters or of composites) is different from one+                  -- determined for template in default language, then this+                  -- template will be discarded (not included in catalog)+                  --+                  -- * if SO is False, don't be strict with templates -+                  -- different language versions of one same template are+                  -- allowed to have different sets of composites and+                  -- parameters+                  soStrict_IsIt :: Bool+                  -- |+                  --+                  -- * if SO is True , don't be strict with contents of+                  --      these templates;+                  --+                  -- * if SO is False,       be strict with contents of+                  -- ONLY these templates+                , soExcludingInComposites   :: [PCLT_ID]+                  -- |+                  --+                  -- * if SO is True , don't be strict with occurences of+                  --      these templates as composites;+                  --+                  -- * if SO is False,       be strict with occurences of+                  -- ONLY these templates as composites+                , soExcludingComposites     :: [PCLT_ID]+                  -- |+                  --+                  -- * if SO is True , don't be strict with+                  --      these parameters;+                  --+                  -- * if SO is False,       be strict with+                  -- ONLY these parameters+                , soExcludingParameters     :: [PCLT_ParamKey]+                  -- |+                  --+                  -- * if SO is True , don't be strict with      these+                  -- referenced parameters in referenced templates;+                  --+                  -- * if SO is False,       be strict with ONLY these+                  -- referenced parameters in referenced templates+                , soExcludingCompComposites :: [(PCLT_ID, PCLT_ID)]+                  -- |+                  --+                  -- * if SO is True , don't be strict with      these+                  -- referenced composites in referenced templates;+                  --+                  -- * if SO is False,       be strict with ONLY these+                  -- referenced composites in referenced templates+                , soExcludingCompParameters :: [(PCLT_ID, PCLT_ParamKey)]+        }+      deriving (Read, Show, Typeable)++----------------------------------------------++type PCLT_InnerConfigID = Int+-- | NOT USED, RESERVED FOR FUTURE VERSIONS OF PCLT!+type ReparsingDepth     = Int++data PCLT_InnerConfig = PCLT_InnerConfig {+                pcsInnerConfigID :: PCLT_InnerConfigID+              -- | Symbols sequence denoting wrapping parentheses (identical+              -- for both - openning ang closing), that are to be put+              -- around *composite* name in a template text.+              , pcsCompositePlaceholderWrapper :: Lazy.ByteString+              -- | Symbols sequence denoting wrapping parentheses (identical+              -- for both - openning ang closing), that are to be put+              -- around *parameter* name in a template text.+              , pcsParameterPlaceholderWrapper :: Lazy.ByteString+              -- | For case, when representation reciever uses detalization+              -- level, that isn't enough to meet requirement specified by+              -- the template (from which representation was to be made):+              -- symbols sequence, that PCLT engine must place+              -- instead of content from template/composite.+              , pcsInsuficientDetLevelPlaceholder :: Lazy.ByteString+              -- | Symbols sequence denoting wrapping parentheses (identical+              -- for both - openning ang closing), that are to be put+              -- (by PCLT engine) in representation, where it failed to+              -- make a proper representation from a template piece+              -- (composite or parameter).+              , pcsMarkingErrorPlaceholderWrapper :: Lazy.ByteString+              -- | Catalog default (primary) language.+              , pcsDefaultLanguage                :: LanguageName+              -- | Object:+              --+              -- 1. Should all localizations of template be strictly oriented+              -- on localization in default (primary) language? (in case of+              -- such orientation, NO template localized in a nondefault+              -- language is allowed to have sets of composites and+              -- parameters different from ones specified for template+              -- localization in the default language)+              --+              -- 2. Exclusions - when not to be strict with templates+              -- structures, - if strictness is on;+              -- or when to be strict, - if strictness is off.+              , pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets :: StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets+              -- | Is it allowed to demand representations from catalog, when+              -- referenced template/composite ID isn't known in given+              -- catalog?+              -- In case, if allowed, on place of unknown composite+              -- the engine (when making representation) will simply put+              -- it's (unknown) ID (given that recievers detailization level+              -- statisfies a requirement: it must be maximal (infinitely+              -- big)), followed by (if enabled by other config parameter)+              -- all the parameters used by current instaniation.+              , pcsAllowUntemplatedMessages                :: Bool+              -- | Is it allowed to demand representations from catalog, when+              -- referenced template/composite ID is persistent in catalog,+              -- but not in representation language?+              -- In case, if allowed, on place of unknown composite+              -- the engine (when making representation) will simply put+              -- it's (unknown) ID (given that recievers detailization level+              -- statisfies a requirement: it must be maximal (infinitely+              -- big)), followed by (if enabled by other config parameter)+              -- all the parameters used by current instaniation.+              , pcsAllowUntemplatedLocalizationsOfMessages :: Bool+              -- | If it's allowed to require representation of+              -- a template/composite (or it's localisation), that is absent+              -- in catalog then (given that reciever's detailization level+              -- statisfies a requirement: it must be maximal (infinitely+              -- big)) together with it's (unknown composite) ID:+              -- should there also be put all the parameters (array of+              -- name:value pairs), used by current instaniation?+              , pcsShowAdhocParamsInResultOfUntemplated    :: Bool+              -- | DEFAULT maximal allowed size of representation resulting from+              -- instaniation of a single PCSI. If user gives on the input+              -- his ConstraintedLBS with different constraint on size, then his+              -- constraint is used instead.+              , pcsInstaniationResultMaxSize      :: Int64+              -- | Is it allowed to give an empty value to the field+              -- \"representation detailization level\" ("Text.PCLT.SDL")?+              -- If allowed, then it's value will be chosen automatically+              -- by the margin+              -- depending on modus: maximal (\"+inf\") in case, when it's a+              -- requirement by a template, or minimal (\"zero\"), when it's+              -- an assigment to a reciever of representation+              , pcsAllowEmptySDL_parseItByModusMargin      :: Bool+              -- | Is it allowed to give an unreadable value to the field+              -- \"representation detailization level\" ("Text.PCLT.SDL")?+              -- If allowed,+              -- then it's value will be chosen automatically by the margin+              -- depending on modus: maximal (\"+inf\") in case, when it's a+              -- requirement by a template, or minimal (\"zero\"), when it's+              -- an assigment to a reciever of representation+              , pcsAllowUnreadableSDL_parseIdByModusMargin :: Bool+              -- | If @pcsi2text@ ("Text.PCLT.MakeMessage") function fails to+              -- determine an SDL requiered by used template (due to+              -- referential cycle, missing referenced template,+              -- @PCLT_SDL_Errornous@ or other reason) - should this failure+              -- lead to absolute denial to represent problem template, or+              -- should the @pcsi2text@ treat it like \"+inf\"+              -- (@PCLT_SDL InfinitelyBig_SDL@)? The error will be returned+              -- anyway, but question is purely about output representation.+              , pcsAllowFailureToDetermineSDL_parseIdByModusMargin :: Bool+              -- | Sequence of symbols used, when representing a specialcase+              -- of parameter value - @Newline_PV@ ("Text.PCLT.PCSI").+              -- (Different OSes use different newline strings: in Linux it's+              -- \#10, in M\$ - \#13\#10, MacOS - \#13)+              , pcsNewlineLBS :: Lazy.ByteString+              -- | NOT USED, RESERVED FOR FUTURE VERSIONS OF PCLT!+              -- Maximal allowed depth of reparsing.+              , pcsReparsingDepthMax              :: ReparsingDepth -- reserved for new parameter value type, won't influence catalog functioning in this version+              -- | NOT USED, RESERVED FOR FUTURE VERSIONS OF PCLT!+              -- Maximal allowed size of representation resuling from+              -- instaniating a reparsing result.+              , pcsReparseParameterContentMaxSize :: Int64          -- reserved for new parameter value type, won't influence catalog functioning in this version+        } deriving (Show, Typeable)++{- |+   >  PCLT_InnerConfig {+   >            pcsInnerConfigID = 0+   >          , pcsCompositePlaceholderWrapper = B.pack "##|"+   >          , pcsParameterPlaceholderWrapper = B.pack "@@|"+   >          , pcsInsuficientDetLevelPlaceholder = B.pack "#x#"+   >          , pcsMarkingErrorPlaceholderWrapper = B.pack "/!E!\"+   >          , pcsDefaultLanguage                = "eng"+   >          , pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets =+   >                    StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets {+   >                              soStrict_IsIt = True+   >                            , soExcludingInComposites   = []+   >                            , soExcludingComposites     = []+   >                            , soExcludingParameters     = []+   >                            , soExcludingCompComposites = []+   >                            , soExcludingCompParameters = []+   >                    }+   >          , pcsAllowUntemplatedMessages                = True+   >          , pcsAllowUntemplatedLocalizationsOfMessages = True+   >          , pcsShowAdhocParamsInResultOfUntemplated    = True+   >          , pcsInstaniationResultMaxSize               = 10000000+   >          , pcsAllowEmptySDL_parseItByModusMargin      = False+   >          , pcsAllowUnreadableSDL_parseIdByModusMargin = False+   >          , pcsAllowFailureToDetermineSDL_parseIdByModusMargin = False+   >          , pcsNewlineLBS                              = B.pack "\n"+   >    }+-}+defaultPCLTInnerConfig :: PCLT_InnerConfig+defaultPCLTInnerConfig = PCLT_InnerConfig {+                pcsInnerConfigID = 0+              , pcsCompositePlaceholderWrapper = B.pack "##|" -- f.e., "Hello, @@|Name@@|! ##|InvitationComposite##|"+              , pcsParameterPlaceholderWrapper = B.pack "@@|"+              , pcsInsuficientDetLevelPlaceholder = B.pack "#x#"+              , pcsMarkingErrorPlaceholderWrapper = B.pack "/!E!\\"+              , pcsDefaultLanguage                = "eng"+              , pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets =+                        StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets {+                                  soStrict_IsIt = True+                                , soExcludingInComposites   = []+                                , soExcludingComposites     = []+                                , soExcludingParameters     = []+                                , soExcludingCompComposites = []+                                , soExcludingCompParameters = []+                        }+              , pcsAllowUntemplatedMessages                = True+              , pcsAllowUntemplatedLocalizationsOfMessages = True+              , pcsShowAdhocParamsInResultOfUntemplated    = True+              , pcsInstaniationResultMaxSize      = 10000000+              , pcsAllowEmptySDL_parseItByModusMargin      = False+              , pcsAllowUnreadableSDL_parseIdByModusMargin = False+              , pcsAllowFailureToDetermineSDL_parseIdByModusMargin = False+              , pcsNewlineLBS                     = B.pack "\n"+              , pcsReparsingDepthMax              = 100+              , pcsReparseParameterContentMaxSize = 50000 -- in the next version wanna make reparsing tail-recursive to get rid of this workaroundish cfg param+        }
+ Text/PCLT/HasStaticRawPCLTs.hs view
@@ -0,0 +1,72 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | A way to store templates is by assigning them to types.+module Text.PCLT.HasStaticRawPCLTs where++import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.MyHelpers+import Data.Typeable+import Text.PCLT.Config+import Text.PCLT.Catalog+import Text.PCLT.CatalogMaths+import Text.PCLT.MakeCatalog+import Text.PCLT.Template++data RawPCLTsSetWideness = AlgebraicDataType_RPSW | Module_RPSW | Package_RPSW | System_RPSW deriving (Show, Typeable)+class HasStaticRawPCLTs t where+     getStaticRawPCLTs :: PCLT_InnerConfig -> t -> (PCLT_RawCatalogData, [AddPCLT_toPCLT_Error])+     -- assumed usage: getStaticRawPCLTs inner_cfg (undefined :: MyType)+     widenessOfStaticRawPCLTsSet :: t -> RawPCLTsSetWideness+     widenessOfStaticRawPCLTsSet _ = AlgebraicDataType_RPSW -- default+------------------------------++mergeRawCatalogDataSets :: Bool -> [PCLT_RawCatalogData] -> (PCLT_RawCatalogData, [AddPCLT_toPCLT_Error])+mergeRawCatalogDataSets allow_overlaps wrapped_rcd_l =+        let rcd_l = map (\ (PCLT_RawCatalogData rcd) -> rcd) wrapped_rcd_l+            (rcd_r, errs) = foldr f (M.empty, []) rcd_l+         in (PCLT_RawCatalogData rcd_r, errs)+    where+        f rcd (rcd_accum, errs_list) =+           unionWithKey_2+                (\ tpl_id ((bylng_m1, sdl1), (bylng_m2, sdl2)) ->+                        let mb_sdl_err =+                                case sdl1 == sdl2 of+                                    True  -> []+                                    False -> [DifferentSDLs_APTTPTE $ DifferentSDLs_PCLTE tpl_id (sdl1, sdl2)]+                         in case allow_overlaps of+                                True  -> ((M.union bylng_m1 bylng_m2, sdl1), mb_sdl_err)+                                False ->+                                    let (bylng_mr, errs) =+                                                unionWithKey_2+                                                    (\ lng (str1, _) ->+                                                                ( str1+                                                                , [AddLngTpl_toPCLT_Error_APTTPTE $ TplUniquenessViol_APSTPTE $ TplUniquenessViol_PCLTE tpl_id [lng]]+                                                                )+                                                    )+                                                    (++)+                                                    mb_sdl_err+                                                    bylng_m1+                                                    bylng_m2+                                     in ((bylng_mr, sdl1), errs ++ mb_sdl_err)+                )+                (++)+                errs_list+                rcd_accum+                rcd++mergeRawCatalogDataSets2 :: Bool -> [(PCLT_RawCatalogData, [AddPCLT_toPCLT_Error])] -> (PCLT_RawCatalogData, [AddPCLT_toPCLT_Error])+mergeRawCatalogDataSets2 allow_overlaps wrapped_rcd_l_w_errs =+        let (wrapped_rcd_l, _errs) = unzip wrapped_rcd_l_w_errs+            errs0 = concat _errs+            (wrapped_rcd_r, errs1) = mergeRawCatalogDataSets allow_overlaps wrapped_rcd_l+         in (wrapped_rcd_r, errs0 ++ errs1)
+ Text/PCLT/InitialDefaultCatalog.hs view
@@ -0,0 +1,55 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++module Text.PCLT.InitialDefaultCatalog where++import Text.PCLT.SDL__               (PCLTRawCatalog__Text_PCLT_SDL)+import Text.PCLT.ShowAsPCSI__        (PCLTRawCatalog__Text_PCLT_ShowAsPCSI)+import Text.PCLT.Template__          (PCLTRawCatalog__Text_PCLT_Template)+import Text.PCLT.CatalogFromHSRT__   (PCLTRawCatalog__Text_PCLT_CatalogFromHSRT)+import Text.PCLT.CatalogMaths__      (PCLTRawCatalog__Text_PCLT_CatalogMaths)+import Text.PCLT.Catalog__           (PCLTRawCatalog__Text_PCLT_Catalog)+import Text.PCLT.MakeCatalog__       (PCLTRawCatalog__Text_PCLT_MakeCatalog)+import Text.PCLT.MakeMessage__       (PCLTRawCatalog__Text_PCLT_MakeMessage)++import Text.ConstraintedLBS+import Text.PCLT.Catalog           (PCLT_CatalogID, PCLT_Catalog)+import Text.PCLT.CatalogFromHSRT+import Text.PCLT.CommonTypes       (LanguageName)+import Text.PCLT.Config+import Text.PCLT.HasStaticRawPCLTs+import Text.PCLT.SDL               (ShowDetalizationLevel)++-- | This type is a special instance of 'HasStaticRawPCLTs' - it accumulates+-- all other instances of 'HasStaticRawPCLTs' from the whole PCLT package+data PCLTRawCatalog__Text_PCLT_InitialDefaultCatalog = PCLTRawCatalog__Text_PCLT_InitialDefaultCatalog++instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_InitialDefaultCatalog where+     widenessOfStaticRawPCLTsSet _ = Package_RPSW+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                        [ getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_SDL)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_ShowAsPCSI)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_Template)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_CatalogFromHSRT)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_CatalogMaths)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_Catalog)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_MakeCatalog)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_MakeMessage)+                        ]++initDefaultCatalog   :: PCLT_InnerConfig -> PCLT_CatalogID                                                       -> (PCLT_Catalog, CatalogFromHSRTInitErrors)+initDefaultCatalog_2 :: PCLT_InnerConfig -> PCLT_CatalogID -> (StdErr_CLBS, ShowDetalizationLevel, LanguageName) -> (PCLT_Catalog, StdErr_CLBS)+initDefaultCatalog_3 ::                     PCLT_CatalogID -> (StdErr_CLBS, ShowDetalizationLevel, LanguageName) -> (PCLT_Catalog, StdErr_CLBS)++initDefaultCatalog   = initCatalogFromHSRT   PCLTRawCatalog__Text_PCLT_InitialDefaultCatalog+initDefaultCatalog_2 = initCatalogFromHSRT_2 PCLTRawCatalog__Text_PCLT_InitialDefaultCatalog+initDefaultCatalog_3 = initCatalogFromHSRT_2 PCLTRawCatalog__Text_PCLT_InitialDefaultCatalog defaultPCLTInnerConfig
+ Text/PCLT/MakeCatalog.hs view
@@ -0,0 +1,499 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# LANGUAGE DeriveDataTypeable #-}++-- | A module around comlex function '_readPCLTCatalog'.+module Text.PCLT.MakeCatalog where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import Data.List+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.Maybe+import Data.MyHelpers+import Data.Typeable+import Text.PCLT.Catalog+import Text.PCLT.CommonTypes+import Text.PCLT.Config+import Text.PCLT.SDL+import Text.PCLT.Template++type Parsed_DidWe = Bool+-- | Error type for '_readPCLTCatalog'.+--+-- Descriptios for some value constructors:+--+-- * 'DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_RPCSCE':+-- For more information about this error see+-- 'Text.PCLT.Config.StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets'+--+-- * 'DifferentSDLs_RPCSCE':+-- This may occur in case when some 'PCLT_RawCatalogData' is+-- added to a nonempty 'PCLT_Catalog', and same templates in both+-- places has different SDL requirements.+--+-- * 'TplUniquenessViol_RPCSCE':+-- This may occur in case when some 'PCLT_RawCatalogData' is+-- added to a nonempty 'PCLT_Catalog', and there isan intersection+-- between their \{(Template ID, Language)\} sets.+--+-- * 'SDL_ToCompositeLinkRefsToNonexistent_RPCSCE':+-- SDL requirement specification+-- ('Text.PCLT.Template.pcltRequiredSDL') for a template is of type+-- 'Text.PCLT.Template.PCLT_SDL_ToTemplateLink' and references to+-- a template which is not persistant in catalog or raw input data.+data ReadPCSCatalogError =+          CompositionCycle_RPCSCE              CompositionCycle_PCLTE+        | RequiredCompositeIsMissing_RPCSCE    RequiredByRequirerCompositeIsMissing_PCLTE+        | RequiredCompositeIsUnparsable_RPCSCE RequirerCompositeKey RequiredCompositeKey+        | ParseFailedForDefaultLng_RPCSCE      PCLT_CompositeKey Parsed_DidWe [PCLT_ParserLowLevelFailure]+        | TplDefaultLngIsMissing_RPCSCE        TplDefaultLngIsMissing_PCLTE+        | ParseFailedForNondefaultLng_RPCSCE   PCLT_CompositeKey Parsed_DidWe LanguageName [PCLT_ParserLowLevelFailure]+        | DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_RPCSCE+                                               DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_PCLTE+        | DifferentSDLs_RPCSCE                 DifferentSDLs_PCLTE+        | TplUniquenessViol_RPCSCE             TplUniquenessViol_PCLTE+        | SDL_ToCompositeLinkRefsToNonexistent_RPCSCE+                                               RequirerCompositeKey RequiredCompositeKey+        | DRL_NormalizationError_RPCSCE        DRL_NormalizationError+       deriving (Show, Typeable)++-- | Wrapper around '_readPCLTCatalog'. To be used when starting with an empty catalog.+readPCLTCatalog :: PCLT_InnerConfig -> PCLT_CatalogID -> PCLT_RawCatalogData -> (PCLT_Catalog, [ErrorWithPCSCatalog ReadPCSCatalogError])+readPCLTCatalog pcsc_config cat_id raw_input =+        let init_cat = PCLT_Catalog {+                  pcltcCatalogID   = cat_id+                , pcltcCatalogMap  = M.empty+                , pcltcInnerConfig = pcsc_config+                }+         in _readPCLTCatalog (init_cat, []) raw_input++-- | Take a bunch of raw templates, parse them into normal templates and add+-- them to a catalog.+_readPCLTCatalog :: (PCLT_Catalog, [ReadPCSCatalogError]) -> PCLT_RawCatalogData -> (PCLT_Catalog, [ErrorWithPCSCatalog ReadPCSCatalogError])+_readPCLTCatalog (init_cat, init_errs) (PCLT_RawCatalogData messages_raws_map1) = -- traceShowPaged 5 ("**", M.filterWithKey (\ k _ -> k == "HW" || k == "E_PCLT_P2TE" ) messages_raws_map1) $+        let (messages_raws_map2, pclt_catalog_map1, err_msgs1) =+                                              filterPrepareRawInputData (pcltcCatalogMap init_cat, init_errs) messages_raws_map1+            (pclt_catalog_map2 , err_msgs2) = processToPCLT_Catalog     (pclt_catalog_map1       , err_msgs1) messages_raws_map2+            (pclt_catalog_map3 , err_msgs3) = normalizeReferentialSDLs   pclt_catalog_map2+            err_msgs = map (ErrorWithPCSCatalog cat_id)+                           (err_msgs2 ++ map DRL_NormalizationError_RPCSCE err_msgs3)+         in ( init_cat { pcltcCatalogMap = pclt_catalog_map3 }, err_msgs )+         where+            cat_id = pcltcCatalogID init_cat+            pcsc_config = pcltcInnerConfig init_cat+            default_lng = pcsDefaultLanguage pcsc_config+            so = pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets pcsc_config+            err6 msg_id buf            = CompositionCycle_RPCSCE $ CompositionCycle_PCLTE+                                                                              msg_id buf+            err7 msg_id subcomp_id     = RequiredCompositeIsMissing_RPCSCE $ RequiredByRequirerCompositeIsMissing_PCLTE msg_id $ RequiredCompositeIsMissing_PCLTE subcomp_id+            err8 msg_id subcomp_id     = RequiredCompositeIsUnparsable_RPCSCE msg_id subcomp_id+            err12 msg_id pdw errs_list = ParseFailedForDefaultLng_RPCSCE      msg_id pdw errs_list+            err13 msg_id               = TplDefaultLngIsMissing_RPCSCE $ TplDefaultLngIsMissing_PCLTE+                                                                              msg_id+            err14 msg_id pdw lng errs_list+                                       = ParseFailedForNondefaultLng_RPCSCE   msg_id pdw lng errs_list+            err15 msg_id lng           = DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_RPCSCE $ DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_PCLTE+                                                                              msg_id lng+            err16 msg_id (msdl, asdl)  = DifferentSDLs_RPCSCE     $ DifferentSDLs_PCLTE msg_id (msdl, asdl)+            err17 msg_id lng_list      = TplUniquenessViol_RPCSCE $ TplUniquenessViol_PCLTE msg_id lng_list+            err20 msg_id subcomp_id    = SDL_ToCompositeLinkRefsToNonexistent_RPCSCE+                                                                              msg_id subcomp_id+            -----------------------------------------------------------+            filterPrepareRawInputData :: ( PCLT_CatalogMap, [ReadPCSCatalogError] )+                                      ->   Map PCLT_CompositeKey (Map LanguageName Lazy.ByteString, PCLT_RequiredShowDetalizationLevel)+                                      -> ( Map PCLT_CompositeKey (Map LanguageName (Either LocalizedTemplate Lazy.ByteString), PCLT_RequiredShowDetalizationLevel)+                                         , Map PCLT_CompositeKey LocalizableTemplate -- PCLT_CatalogMap+                                         , [ReadPCSCatalogError]+                                         )+            filterPrepareRawInputData (processed_msgs_accum_map1, errs_accum) raw_msgs_src_map =+                     let makeInputEntry :: PCLT_ID+                                        -> ( Maybe LocalizableTemplate+                                           , Maybe (Map LanguageName Lazy.ByteString, PCLT_RequiredShowDetalizationLevel))+                                        -> ( Map LanguageName (Either LocalizedTemplate Lazy.ByteString)+                                           , PCLT_RequiredShowDetalizationLevel+                                           , [ReadPCSCatalogError]+                                           )+                         makeInputEntry k (mb_pclt, mb_mapByLng) =+                             let unionWithKey_3_ERROR = error "Severe internal error (in _readPCLTCatalog) unionWithKey_3(4) can't give (Nothing, Nothing) to the unifier !!!"+                              in case (mb_pclt, mb_mapByLng) of+                                    (Nothing  , Nothing)               -> unionWithKey_3_ERROR+                                    (Nothing  , Just (mapByLng, sdl))  -> (M.map Right mapByLng, sdl, [])+                                 -- (Just pclt, Nothing) case processed by the callerof makeInputEntry+                                    (Just pclt, Just (mapByLng, sdl2)) ->+                                        let sdl1 = pcltRequiredSDL pclt+                                            (result_mapByLng, uniqviol_lng_list) = unionWithKey_3+                                                (\ lng (mb_ldt, mb_rawInput) -> -- unifierF+                                                        case (mb_ldt, mb_rawInput) of+                                                            (Nothing  , Nothing)       -> unionWithKey_3_ERROR+                                                            (Nothing  , Just rawInput) -> (Right rawInput, [])+                                                            (Just ldt, Nothing)       -> (Left  ldt    , [])+                                                            (Just ldt, Just rawInput) -> (Left  ldt    , [lng])+                                                )+                                                (++) -- sideResultAccumF+                                                []+                                                (pcltLocalizationsMap pclt)+                                                mapByLng+                                            errs_add =+                                                   (case sdl1 == sdl2      of { True -> []; False -> [err16 k (sdl1, sdl2)] })+                                                ++ (case uniqviol_lng_list of { []   -> []; l     -> [err17 k l           ] })+                                         in (result_mapByLng, sdl1, errs_add)+                         (raw_msgs_src_map2, (processed_msgs_accum_map2, errs_accum2)) = unionWithKey_4+                                (\ k (mb_pclt, mb_mapByLng) ->+                                        case (mb_pclt, mb_mapByLng) of+                                            (Just pclt, Nothing) -> (Nothing, (M.singleton k pclt, []))+                                            _ -> let (      result_map, sdl ,           errs_add ) = makeInputEntry k (mb_pclt, mb_mapByLng)+                                                  in (Just (result_map, sdl), (M.empty, errs_add))+                                )+                                (apFor2ple (M.union, (++))) -- sideResultAccumF+                                (M.empty, errs_accum)+                                processed_msgs_accum_map1+                                raw_msgs_src_map+                      in (raw_msgs_src_map2, processed_msgs_accum_map2, errs_accum2)+            -----------------------------------------------------------+            processToPCLT_Catalog :: (PCLT_CatalogMap, [ReadPCSCatalogError])+                                  -> (Map PCLT_CompositeKey (Map LanguageName (Either LocalizedTemplate Lazy.ByteString), PCLT_RequiredShowDetalizationLevel))+                                  -> (PCLT_CatalogMap, [ReadPCSCatalogError])+            processToPCLT_Catalog (processed_msgs_accum_map, errs_accum) halfRaw_input =+                        case M.null halfRaw_input of+                            True  -> (processed_msgs_accum_map, errs_accum)+                            False -> let ((k, (msg_raw_lng_map, sdl)), new_raw_msgs_src_map) = M.deleteFindMin halfRaw_input+                                      in uncurry+                                            processToPCLT_Catalog+                                                (processToPCLT_Catalog_Unit+                                                        (processed_msgs_accum_map, errs_accum)+                                                        (k, msg_raw_lng_map, sdl)+                                                        []+                                                        new_raw_msgs_src_map+                                                )+            -----------------------------------------------------------+            parseMsgTemplates :: PCLT_CompositeKey+                              -> Map LanguageName (Either LocalizedTemplate Lazy.ByteString)+                              -> ( [ReadPCSCatalogError]+                                 , Map LanguageName+                                       (Either+                                           LocalizedTemplate+                                           ( LngTpl_AbstractedString+                                           , [PCLT_CompositeKey]+                                 )     )   )+            parseMsgTemplates k raw_msgs_by_lngs_map = -- traceCond (k == "HW" || k == "E_PCLT_P2TE") 5 ("**", raw_msgs_by_lngs_map) $+                case takeFromMap default_lng raw_msgs_by_lngs_map of+                    (Nothing, _) -> ([err13 k], M.empty)+                    (Just default_ldt_or_raw, rest_raw_msgs_by_lngs_map) ->+                        let (mb_default_ldt_or_freshParse, errs_list1, default_list_of_composites, default_list_of_params) =+                                case default_ldt_or_raw of+                                    Left             ldt -> (Just $ Left ldt, [], M.keys $ ldtSubcompositesMap ldt, listOfParams $ ldtAbstractedString ldt)+                                    Right default_raw_msg ->+                                        case doTheParse pcsc_config default_raw_msg of+                                            (errs_list1, Nothing) -> (Nothing, [err12 k False errs_list1], [], [])+                                            (errs_list1, Just default_freshParse@(dflt_str_struct, dflt_list_of_composites)) ->+                                                        ( Just $ Right default_freshParse+                                                        , case null errs_list1 of {True  -> []; False -> [err12 k True errs_list1]}+                                                        , dflt_list_of_composites+                                                        , listOfParams dflt_str_struct+                                                        )+                         in case mb_default_ldt_or_freshParse of+                                Nothing -> (errs_list1, M.empty)+                                Just default_ldt_or_freshParse -> foldr+                                          (\ (lng, ldt_or_raw) (errs_accum, parseds_accum_map) ->+                                                case ldt_or_raw of+                                                    Left ldt -> (errs_accum, M.insert lng (Left ldt) parseds_accum_map)+                                                    Right unparsed_tpl ->+                                                        case doTheParse pcsc_config unparsed_tpl of+                                                            (errs_list2, Nothing) -> (err14 k False lng errs_list2 : errs_accum, parseds_accum_map)+                                                            (errs_list2, Just freshParse@(str_struct, list_of_composites)) ->+                                                               let orients_doesit = _compareStrictOrientationOnDefault k so (default_list_of_composites, default_list_of_params) (list_of_composites, listOfParams str_struct)+                                                                in case orients_doesit of+                                                                       False -> (err15 k lng : errs_accum, parseds_accum_map)+                                                                       True  -> ( case null errs_list2 of+                                                                                      False -> err14 k True lng errs_list2 : errs_accum+                                                                                      True  -> errs_accum+                                                                                , M.insert lng (Right freshParse) parseds_accum_map+                                                                                )+                                          )+                                          (errs_list1, M.singleton default_lng default_ldt_or_freshParse)+                                          (M.toList rest_raw_msgs_by_lngs_map)+            -----------------------------------------------------------+            processToPCLT_Catalog_Unit :: (PCLT_CatalogMap, [ReadPCSCatalogError])+                                      -> (PCLT_CompositeKey, Map LanguageName (Either LocalizedTemplate Lazy.ByteString), PCLT_RequiredShowDetalizationLevel)+                                      -> [PCLT_CompositeKey]+                                      -> (Map PCLT_CompositeKey (Map LanguageName (Either LocalizedTemplate Lazy.ByteString), PCLT_RequiredShowDetalizationLevel))+                                      -> ( (PCLT_CatalogMap, [ReadPCSCatalogError])+                                         , (Map PCLT_CompositeKey (Map LanguageName (Either LocalizedTemplate Lazy.ByteString), PCLT_RequiredShowDetalizationLevel))+                                         )+            processToPCLT_Catalog_Unit (processed_msgs_accum_map, errs_accum) (k, msg_raw_or_ldt_mapByLng, sdl) superprocessed_buffer raw_msgs_src_map =+                let returnWithError err_str = ((processed_msgs_accum_map, err_str : errs_accum), raw_msgs_src_map) in+                case k `elem` superprocessed_buffer of+                    True  -> returnWithError (err6 k superprocessed_buffer)+                    False ->+                        let (errs_list, ldt_or_froshParseds_map) = parseMsgTemplates k msg_raw_or_ldt_mapByLng+                            (ldt_mapByLng1, absStr_mapByLng) = partition_2 isLeft (fromLeft, fromRight) ldt_or_froshParseds_map -- agree... not a best style+                            errs_accum2 = errs_accum ++ errs_list+                            (ldt_mapByLng2, (processed_msgs_accum_map2, raw_msgs_src_map2), errs_accum6) =+                                foldl+                                    (\ (ldt_mapByLng_accum, (_processed_msgs_accum_map1, _raw_msgs_src_map1), errs_accum3) (lng, (msg_chunks_struct, list_of_composites_keys)) ->+                                        let (msg_composites, (_processed_msgs_accum_map2, _raw_msgs_src_map2), errs_accum4) =+                                                foldl+                                                    gatherCatalogUnitSubcomposites+                                                    (M.empty, (_processed_msgs_accum_map1, _raw_msgs_src_map1), errs_accum3)+                                                    list_of_composites_keys+                                            ldt = LocalizedTemplate {+                                                                  ldtAbstractedString  = msg_chunks_struct+                                                                , ldtSubcompositesMap  = msg_composites+                                                         }+                                         in ( M.insert lng ldt ldt_mapByLng_accum+                                            , ( _processed_msgs_accum_map2+                                              , _raw_msgs_src_map2+                                              )+                                            , errs_accum4+                                            )+                                    )+                                    (ldt_mapByLng1, (processed_msgs_accum_map, raw_msgs_src_map), errs_accum2)+                                    (M.toList absStr_mapByLng)+                            pclt = LocalizableTemplate {+                                        pcltRequiredSDL = sdl+                                      , pcltLocalizationsMap = ldt_mapByLng2+                                  }+                         in ((M.insert k pclt processed_msgs_accum_map2, errs_accum6), raw_msgs_src_map2)+              -----------------------------------------------------------+              where+                gatherCatalogUnitSubcomposites :: ( LngTpl_SubCompositesMap+                                                  , ( Map PCLT_ID LocalizableTemplate+                                                    , Map PCLT_CompositeKey (Map LanguageName (Either LocalizedTemplate Lazy.ByteString), PCLT_RequiredShowDetalizationLevel)+                                                    )+                                                  , [ReadPCSCatalogError]+                                                  )+                                               -> PCLT_CompositeKey+                                               -> ( LngTpl_SubCompositesMap+                                                  , ( Map PCLT_ID LocalizableTemplate+                                                    , Map PCLT_CompositeKey (Map LanguageName (Either LocalizedTemplate Lazy.ByteString), PCLT_RequiredShowDetalizationLevel)+                                                    )+                                                  , [ReadPCSCatalogError]+                                                  )+                gatherCatalogUnitSubcomposites (msg_composites_accum, (processed_msgs_accum_map, raw_msgs_src_map), errs_accum) composite_key =+                    let returnWithError str = (msg_composites_accum, (processed_msgs_accum_map, raw_msgs_src_map), str : errs_accum)+                     in case M.lookup composite_key processed_msgs_accum_map of+                                Just pcs -> (M.insert composite_key pcs msg_composites_accum, (processed_msgs_accum_map, raw_msgs_src_map), errs_accum)+                                Nothing  ->+                                   case takeFromMap composite_key raw_msgs_src_map of+                                       (Nothing, _) -> case k == composite_key of+                                                           False -> case composite_key `elem` superprocessed_buffer of+                                                                        False -> returnWithError (err7 k composite_key)+                                                                        True  -> returnWithError (err6 composite_key (composite_key:k:superprocessed_buffer))+                                                           True  -> returnWithError (err6 k [k])+                                       (Just (raw_subcomp_msgs_map_by_lng, sub_sdl), new_raw_msgs_src_map) ->+                                               let ((new_processed_msgs_accum_map, new_errs_accum), new_new_raw_msgs_src_map) =+                                                               processToPCLT_Catalog_Unit+                                                                        (processed_msgs_accum_map, errs_accum)+                                                                        (composite_key, raw_subcomp_msgs_map_by_lng, sub_sdl)+                                                                        (k : superprocessed_buffer)+                                                                        new_raw_msgs_src_map+                                                   returnWithError3 err = (msg_composites_accum, (new_processed_msgs_accum_map, new_new_raw_msgs_src_map), err : new_errs_accum)+                                                in case M.lookup composite_key new_processed_msgs_accum_map of+                                                       Nothing  -> returnWithError3 (err8 k composite_key)+                                                       Just pcs -> (M.insert composite_key pcs msg_composites_accum, (new_processed_msgs_accum_map, new_new_raw_msgs_src_map), new_errs_accum)+                --------------------------------------------------------------------+-- | Error type for 'normalizeReferentialSDLs'.+data DRL_NormalizationError =+          SDL_ToCompositeLinksCycle_DRLNE      [PCLT_CompositeKey]+        | SDL_DetFail_ToCompositeLinkRefsToNonexistent_DRLNE+                                               RequirerCompositeKey RequiredCompositeKey+       deriving (Show, Typeable)++-- | Under \"Referential SDLs normalization\" here is understood the following.+-- Now consider paths like:+--+-- @ Tpl_1.'pcltRequiredSDL' -> Tpl_2.'pcltRequiredSDL'@+--+-- which means 'pcltRequiredSDL' of @Tpl_1@ is specified (using+-- 'PCLT_SDL_ToTemplateLink') to be the same as for @Tpl_2@. Here we can+-- reduce the 'PCLT_SDL_ToTemplateLink' of @Tpl_1@ by assinging instead of it+-- @Tpl_2.@'pcltRequiredSDL' value. Data consistency is respected. We win in+-- speed of @Tpl_1.@'pcltRequiredSDL' determination. The negative side of this,+-- is that we can't change @Tpl_2.@'pcltRequiredSDL' anymore without spoiling+-- data consistency. That's another reason why a PCLT catalog is so hard to+-- modify. Perhaps the problem will be solved in future versions of PCLT.+--+-- So this function reduces all 'PCLT_SDL_ToTemplateLink's in a given+-- 'PCLT_CatalogMap', BUT, only where they lead to 'PCLT_SDL's or+-- to other 'PCLT_SDL_ToTemplateLink's (which recursively gets considered+-- to be reduced), not when it leads to 'PCLT_SDL_ToParamCompositeLink'+-- or 'PCLT_SDL_Errornous'.+normalizeReferentialSDLs :: PCLT_CatalogMap -> (PCLT_CatalogMap, [DRL_NormalizationError])+normalizeReferentialSDLs pclt_catalog_map =+        let err21 buf           = SDL_ToCompositeLinksCycle_DRLNE             buf+            err23 rer_id red_id = SDL_DetFail_ToCompositeLinkRefsToNonexistent_DRLNE+                                                                              rer_id red_id+            determinePCLT_SDL :: (PCLT_ID, LocalizableTemplate)+                              -> (PCLT_CatalogMap, PCLT_CatalogMap, [DRL_NormalizationError], [PCLT_CompositeKey])+                              -> (PCLT_CatalogMap, PCLT_CatalogMap, [DRL_NormalizationError], PCLT_RequiredShowDetalizationLevel)+            determinePCLT_SDL (pclt_id, pclt) (processed_cat_accum, unprocessed_cat_map, err_msg_accum, useds_buf) =+                case pclt_id `elem` useds_buf of+                    True  ->+                            ( M.insert pclt_id pclt processed_cat_accum+                            , unprocessed_cat_map+                            , err_msg_accum ++ [err21 (pclt_id : useds_buf)]+                            , pcltRequiredSDL pclt+                            )+                    False ->+                        case pcltRequiredSDL pclt of+                            PCLT_SDL_ToTemplateLink ref_pclt_id ->+                                case M.lookup ref_pclt_id processed_cat_accum of+                                    Just refed_pclt ->+                                        let sdl = pcltRequiredSDL refed_pclt+                                            upd_sdl = case sdl of+                                                          PCLT_SDL                _ -> sdl+                                                          PCLT_SDL_ToTemplateLink _ -> sdl+                                                          _ -> pcltRequiredSDL pclt+                                            upd_pclt = pclt {pcltRequiredSDL = upd_sdl}+                                         in ( M.insert pclt_id upd_pclt processed_cat_accum+                                            , unprocessed_cat_map+                                            , err_msg_accum+                                            , upd_sdl+                                            )+                                    Nothing ->+                                        case takeFromMap ref_pclt_id unprocessed_cat_map of+                                            (Just unprocessed_refed_pclt, rest_unprocesseds) ->+                                                let (processed_cat_accum2, unprocessed_cat_map2, err_msg_accum2, sdl) = determinePCLT_SDL (ref_pclt_id, unprocessed_refed_pclt) (processed_cat_accum, rest_unprocesseds, err_msg_accum, pclt_id : useds_buf)+                                                    upd_sdl = case sdl of+                                                                  PCLT_SDL                _ -> sdl+                                                                  PCLT_SDL_ToTemplateLink _ -> sdl+                                                                  _ -> pcltRequiredSDL pclt+                                                    upd_pclt = pclt {pcltRequiredSDL = upd_sdl}+                                                 in ( M.insert pclt_id upd_pclt processed_cat_accum2+                                                    , unprocessed_cat_map2+                                                    , err_msg_accum2+                                                    , upd_sdl+                                                    )+                                            (Nothing, _) ->+                                                    ( M.insert pclt_id pclt processed_cat_accum+                                                    , unprocessed_cat_map+                                                    , err_msg_accum ++ [err23 pclt_id ref_pclt_id]+                                                    , pcltRequiredSDL pclt+                                                    )+                            _ -> ( M.insert pclt_id pclt processed_cat_accum+                                 , unprocessed_cat_map+                                 , err_msg_accum+                                 , pcltRequiredSDL pclt+                                 )+            ------------------------------------------------------+            normalizeReferentialSDLs_metaCycle :: (PCLT_CatalogMap, PCLT_CatalogMap, [DRL_NormalizationError])+                                                -> (PCLT_CatalogMap, PCLT_CatalogMap, [DRL_NormalizationError])+            normalizeReferentialSDLs_metaCycle i@(processeds, unprocesseds, errs_accum) =+                case M.null unprocesseds of+                    True -> i+                    False -> let ((pclt_id, pclt), rest_unprocesseds) = M.deleteFindMin unprocesseds+                                 (processeds2, unprocesseds2, errs_accum2, _) = determinePCLT_SDL (pclt_id, pclt) (processeds, rest_unprocesseds, errs_accum, [])+                              in normalizeReferentialSDLs_metaCycle (processeds2, unprocesseds2, errs_accum2)+            ------------------------------------------------------+            (results, _, result_errs_list) = normalizeReferentialSDLs_metaCycle (pclt_catalog_map, M.empty, [])+         in (results, result_errs_list)++------------------------------------------------------------------------+-- | Error type for 'adhoc_str2ldt'.+data AHSTR2LngTpl_Error =+          ParseFailure_AHS2PE               [PCLT_ParserLowLevelFailure]+        | RequiredCompositeIsMissing_AHS2PE RequiredCompositeIsMissing_PCLTE+       deriving (Show, Typeable)++-- | Make a 'Text.PCLT.Template.LocalizedTemplate'+-- out of a single 'ByteString'.+adhoc_str2ldt :: (Lazy.ByteString, LanguageName) -> PCLT_Catalog -> Either AHSTR2LngTpl_Error LocalizedTemplate+adhoc_str2ldt (str, lng) catalog =+        let cfg                = pcltcInnerConfig catalog+            (err_list, mb_pre_ldt) = doTheParse cfg str -- ( [PCLT_ParserLowLevelFailure], Maybe ( LngTpl_AbstractedString, [PCLT_ID] ))+            _allow_untmpl_msgs = pcsAllowUntemplatedMessages cfg+            err1    subcomp_id = RequiredCompositeIsMissing_AHS2PE $ RequiredCompositeIsMissing_PCLTE subcomp_id+         in case mb_pre_ldt of+                Nothing -> Left $ ParseFailure_AHS2PE err_list+                Just (marked_str, composites_keys_list) ->+                        let err_or_subcomposites_map =+                                foldr (\ subc_id err_or_pclt_accum ->+                                            case err_or_pclt_accum of+                                                Left _ -> err_or_pclt_accum+                                                Right pclt_accum ->+                                                    case M.lookup subc_id (pcltcCatalogMap catalog) of+                                                        Nothing ->+                                                                case _allow_untmpl_msgs of+                                                                    True -> err_or_pclt_accum+                                                                    False -> Left $ err1 subc_id+                                                        Just pclt -> Right $ M.insert subc_id pclt pclt_accum+                                      )+                                      (Right M.empty)+                                      composites_keys_list+                         in case err_or_subcomposites_map of+                                Left err_msg -> Left err_msg+                                Right sub_lat_map -> Right LocalizedTemplate {+                                                        ldtAbstractedString = marked_str+                                                      , ldtSubcompositesMap = sub_lat_map+                                                      }++------------------------------------------------------------------------++-- | Make a 'Text.PCLT.Template.LocalizableTemplate'+-- out of a single 'ByteString'.+str2pclt :: (PCLT_ID, PCLT_AllocatedShowDetalizationLevel) -> (LanguageName, Lazy.ByteString) -> PCLT_Catalog -> Either (ErrorWithPCSCatalog ReadPCSCatalogError) LocalizableTemplate+str2pclt (tpl_id, req_sdl) (lng, str) catalog =+        let err_or_ldt = adhoc_str2ldt (str, lng) catalog+         in case err_or_ldt of+                Right ldt -> Right LocalizableTemplate { pcltLocalizationsMap = M.singleton lng ldt, pcltRequiredSDL = req_sdl }+                Left   err -> Left $ ErrorWithPCSCatalog (pcltcCatalogID catalog) $+                                     case err of+                                         ParseFailure_AHS2PE  ll_errs_list -> case lng == catDfltLng catalog of+                                                                                  True  -> ParseFailedForDefaultLng_RPCSCE    tpl_id False     ll_errs_list+                                                                                  False -> ParseFailedForNondefaultLng_RPCSCE tpl_id False lng ll_errs_list+                                         RequiredCompositeIsMissing_AHS2PE red_id -> RequiredCompositeIsMissing_RPCSCE $ RequiredByRequirerCompositeIsMissing_PCLTE tpl_id red_id++-- | Make a 'Text.PCLT.Template.LocalizableTemplate' out of list+-- of 'ByteString's.+str_list2pclt :: (PCLT_ID, PCLT_AllocatedShowDetalizationLevel) -> Map LanguageName Lazy.ByteString -> PCLT_Catalog -> (LocalizableTemplate, [ErrorWithPCSCatalog ReadPCSCatalogError])+str_list2pclt (tpl_id, req_sdl) str_map catalog =+        let so = catStrictOrient catalog+            dflt_lng = catDfltLng catalog+            (mb_err_or_pclt_w_dfltlng, nodfltlng_str_list) =+                    let (mb_dfltlng_str, left_) = takeFromMap dflt_lng str_map+                     in ( mb_dfltlng_str >>= \ str -> return $ str2pclt (tpl_id, req_sdl) (dflt_lng, str) catalog+                        , left_+                        )+            (errs_list1, pclt1, mb_dflt_ldt) =+                                  case mb_err_or_pclt_w_dfltlng of+                                      Nothing           -> ([]   , LocalizableTemplate { pcltLocalizationsMap = M.empty, pcltRequiredSDL = req_sdl}, Nothing)+                                      Just (Left   err) -> ([err], LocalizableTemplate { pcltLocalizationsMap = M.empty, pcltRequiredSDL = req_sdl}, Nothing)+                                      Just (Right pclt) ->+                                                       let dflt_ldt = pcltLocalizationsMap pclt ! dflt_lng -- compareStrictOrientationOnDefault+                                                        in ([]   , pclt, Just dflt_ldt)+            dflt_persists = isJust mb_dflt_ldt+         in foldr+                (\ (lng, str) (pclt_accum, errs_accum) ->+                        let err_or_pclt2 = str2pclt (tpl_id, req_sdl) (lng, str) catalog+                         in case err_or_pclt2 of+                                Left  arpcsce -> (pclt_accum, arpcsce : errs_accum)+                                Right pclt2 ->+                                        let good_outcome = ( pclt_accum { pcltLocalizationsMap = M.union (pcltLocalizationsMap pclt_accum) (pcltLocalizationsMap pclt2)}+                                                           , errs_accum+                                                           )+                                         in case dflt_persists of+                                                False -> good_outcome+                                                True  ->+                                                     let cur_ldt  = pcltLocalizationsMap pclt2 ! lng+                                                         dflt_ldt = fromJust mb_dflt_ldt+                                                      in case compareStrictOrientationOnDefault tpl_id so cur_ldt dflt_ldt of+                                                             True  -> good_outcome+                                                             False -> let err = ErrorWithPCSCatalog+                                                                                        (pcltcCatalogID catalog)+                                                                                        (DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_RPCSCE $+                                                                                                DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_PCLTE tpl_id lng)+                                                                       in (pclt_accum, err : errs_accum)+                )+                (pclt1, errs_list1)+                (M.toList nodfltlng_str_list)
+ Text/PCLT/MakeCatalog__.hs view
@@ -0,0 +1,155 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# OPTIONS_HADDOCK hide #-}++module Text.PCLT.MakeCatalog__ where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Text.PCLT.SH__+import Text.PCLT.MakeCatalog+import Text.PCLT.Catalog__+import Text.PCLT.Template__++-------------------------------------------++instance ShowAsPCSI DRL_NormalizationError where+        showAsPCSI drlne = thePCSI "E_PCLT_DRLNE" [("pclt_drlne_err_details", PCSI_PV err_pcsi)]+           where+             err_pcsi =+                case drlne of+                    SDL_ToCompositeLinksCycle_DRLNE                              buf ->+                                thePCSI "E_PCLT_DRLNE_CYCL"        [("buf", PlainText_PV $ show buf)]+                    SDL_DetFail_ToCompositeLinkRefsToNonexistent_DRLNE rer_id red_id ->+                                thePCSI "E_PCLT_DRLNE_BADREF"      [("rer_id", PlainText_PV rer_id), ("red_id", PlainText_PV red_id)]++instance HasStaticRawPCLTs DRL_NormalizationError where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLT_DRLNE", (M.fromList [("rus", B.pack "##|E_PCLT_DRLNE_PREFIX##|@@|pclt_drlne_err_details@@|."), ("eng", B.pack "##|E_PCLT_DRLNE_PREFIX##|@@|pclt_drlne_err_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_DRLNE_PREFIX", (M.fromList [("rus", B.pack "Произошла ошибка во время окончательной нормализации [требований к уровням детализации для отображения]: "), ("eng", B.pack "An error occured during normalization of detalization level requirements (DRL) of message templetes:")], str2PCLT_SDL Required_SDLM "##|E_PCLT_DRLNE##|" inner_cfg))+                        , ("E_PCLT_DRLNE_CYCL", (M.fromList [("rus", B.pack "обнаружен ссылочный композиционный цикл. Буфер композитов: @@|buf@@|"), ("eng", B.pack "compositional referential cycle detected. Composites buffer: @@|buf@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_DRLNE##|" inner_cfg))+                        , ("E_PCLT_DRLNE_BADREF", (M.fromList [("rus", B.pack "не получается определить требование к уровню детализации шаблона (ИД: @@|red_id@@|), на который ссылается шаблон, чей ИД - @@|rer_id@@|. Шаблон на который ссылка — отсутствует."), ("eng", B.pack "couldn't determine the DRL of referenced template (ID: @@|red_id@@|), referenced by a composite (ID: @@|rer_id@@|) DRL. Referenced template is missing.")], str2PCLT_SDL Required_SDLM "##|E_PCLT_DRLNE##|" inner_cfg))+                        ]++-------------------------------------------------++instance ShowAsPCSI ReadPCSCatalogError where+        showAsPCSI rpcsce = thePCSI "E_PCLT_RPCSCE" [("pclt_rpcsce_err_details", PCSI_PV err_pcsi)]+           where+             err_pcsi =+                case rpcsce of+                    CompositionCycle_RPCSCE cc ->+                            addToPCSI+                                [ showAsPCSI cc]+                                (    empPCSI "E_PCLT_RPCSCE_CCYCL")+                    RequiredCompositeIsMissing_RPCSCE rrcim ->+                            addToPCSI+                                [ showAsPCSI rrcim]+                                (    empPCSI "E_PCLT_RPCSCE_MISSINGCOMPST")+                    RequiredCompositeIsUnparsable_RPCSCE rer_id red_id ->+                                thePCSI "E_PCLT_RPCSCE_UNPARSABLECOMPST"+                                        [ ("rer_id", PlainText_PV rer_id)+                                        , ("red_id", PlainText_PV red_id)+                                        ]+                    ParseFailedForDefaultLng_RPCSCE tpl_id pdw ll_errs_list ->+                                thePCSI "E_PCLT_RPCSCE_DFLTLNGPARSEFAIL"+                                        [ ("tpl_id", PlainText_PV tpl_id)+                                        , ("if_not_parsed", case pdw of {True -> Nothing_PV; False -> PCSI_PV $ empPCSI "E_PCLT_RPCSCE_DFLTLNGPARSEFAIL_C"} )+                                        , ("ll_errs_list", Indented_PV 4 $ PCSIList_PV (map showAsPCSI ll_errs_list) usualSeparatorInPCSIList)+                                        ]+                    TplDefaultLngIsMissing_RPCSCE tdlim ->+                            addToPCSI+                                [showAsPCSI tdlim]+                                (   empPCSI "E_PCLT_RPCSCE_TDLIM")+                    ParseFailedForNondefaultLng_RPCSCE tpl_id pdw lng ll_errs_list ->+                                thePCSI "E_PCLT_RPCSCE_NDFLTLNGPARSEFAIL"+                                        [ ("tpl_id", PlainText_PV tpl_id)+                                        , ("if_not_parsed", case pdw of {True -> Nothing_PV; False -> PCSI_PV $ empPCSI "E_PCLT_RPCSCE_NDFLTLNGPARSEFAIL_C"} )+                                        , ("ll_errs_list", Indented_PV 4 $ PCSIList_PV (map showAsPCSI ll_errs_list) usualSeparatorInPCSIList)+                                        , ("lng", PlainText_PV lng)+                                        ]+                    DefaultLngTplComponentsParamsSetsDiffersFromOnesOfNondefault_RPCSCE dltcpsdfoon ->+                            addToPCSI+                                [showAsPCSI dltcpsdfoon]+                                (   empPCSI "E_PCLT_RPCSCE_DLTCPSDFOON")+                    DifferentSDLs_RPCSCE dsdls ->+                            addToPCSI+                                [showAsPCSI dsdls]+                                (   empPCSI "E_PCLT_RPCSCE_DIFFSDLS")+                    TplUniquenessViol_RPCSCE tuv ->+                            addToPCSI+                                [showAsPCSI tuv]+                                (   empPCSI "E_PCLT_RPCSCE_UNIQUEVIOL")+                    SDL_ToCompositeLinkRefsToNonexistent_RPCSCE rer_id red_id ->+                                thePCSI "E_PCLT_RPCSCE_SDLPTRTONONEXIST" [("rer_id", PlainText_PV rer_id), ("red_id", PlainText_PV red_id)]+                    DRL_NormalizationError_RPCSCE drlne ->+                                thePCSI "E_PCLT_RPCSCE_DRLNE" [("drlne", PCSI_PV $ showAsPCSI drlne)]++instance HasStaticRawPCLTs ReadPCSCatalogError where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLT_RPCSCE", (M.fromList [("rus",  B.pack "##|E_PCLT_RPCSCE_PREFIX##|@@|pclt_rpcsce_err_details@@|."), ("eng",  B.pack "##|E_PCLT_RPCSCE_PREFIX##|@@|pclt_rpcsce_err_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_PREFIX", (M.fromList [("rus",  B.pack "Произошла ошибка при чтении/формировании каталога шаблонов стандартных локализуемых детализуемых сообщений: "), ("eng",  B.pack "An error occured during formation of standard messages templates catalog:")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_CCYCL", (M.fromList [("rus",  B.pack "##|E_PCLT_COMMONS_CCYCL##|"), ("eng",  B.pack "##|E_PCLT_COMMONS_CCYCL##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_MISSINGCOMPST", (M.fromList [("rus",  B.pack "##|E_PCLT_COMMONS_MISSINGCOMPSTBYRER##|"), ("eng",  B.pack "##|E_PCLT_COMMONS_MISSINGCOMPSTBYRER##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_UNPARSABLECOMPST", (M.fromList [("rus",  B.pack "композит (ИД: @@|red_id@@|), на который ссылается шаблон (ИД: @@|rer_id@@|), наличествует во входе на формирование каталога, но (этот требуемый шаблон) не парсится"), ("eng",  B.pack "a composite (ID: @@|red_id@@|) required by the message template (ID: @@|rer_id@@|) is found in raw data for catalog, but parsing it failed")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_DFLTLNGPARSEFAIL", (M.fromList [("rus",  B.pack "шаблон (ИД: @@|tpl_id@@|) на основном языке не парсится без ошибок. @@|if_not_parsed@@|Список ошибок выданый парсером: @@|ll_errs_list@@|"), ("eng",  B.pack "a message template (ID: @@|tpl_id@@|) in default language is parsed (separation on composites, parameters and plain text) with errors. @@|if_not_parsed@@|Parse error(s): @@|ll_errs_list@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_DFLTLNGPARSEFAIL_C", (M.fromList [("rus",  B.pack "ДЛЯ ВСЕХ ЯЗЫКОВ данный шаблон будет отвергнут. "), ("eng",  B.pack "FOR ALL LANGUAGES the message template will be discarded. ")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE_DFLTLNGPARSEFAIL##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_TDLIM", (M.fromList [("rus",  B.pack "##|E_PCLT_COMMONS_TDLIM##|"), ("eng",  B.pack "##|E_PCLT_COMMONS_TDLIM##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_NDFLTLNGPARSEFAIL", (M.fromList [("rus", B.pack "шаблон (ИД: @@|tpl_id@@|) на НЕосновном языке ('@@|lng@@|') не парсится без ошибок. @@|if_not_parsed@@|Список ошибок выданый парсером: @@|ll_errs_list@@|"), ("eng", B.pack "a message template (ID: @@|tpl_id@@|) in nondefault language ('@@|lng@@|') is parsed (separation on composites, parameters and plain text) with errors. @@|if_not_parsed@@|Parse error(s): @@|ll_errs_list@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_NDFLTLNGPARSEFAIL_C", (M.fromList [("rus",  B.pack "Для данного языка этот шаблон будет отвергнут. "), ("eng",  B.pack "The message template for this language will be discarded. ")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE_NDFLTLNGPARSEFAIL##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_DLTCPSDFOON", (M.fromList [("rus",  B.pack "##|E_PCLT_COMMONS_DLTCPSDFOON##|"), ("eng",  B.pack "##|E_PCLT_COMMONS_DLTCPSDFOON##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_DIFFSDLS", (M.fromList [("rus", B.pack "##|E_PCLT_COMMONS_DIFFSDLS##|"), ("eng", B.pack "##|E_PCLT_COMMONS_DIFFSDLS##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_UNIQUEVIOL", (M.fromList [("rus", B.pack "##|E_PCLT_COMMONS_UNIQUEVIOL##|"), ("eng", B.pack "##|E_PCLT_COMMONS_UNIQUEVIOL##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_SDLPTRTONONEXIST", (M.fromList [("rus",  B.pack "необходимый для отображения (сообщения по шаблону ИД: @@|rer_id@@|)) уровень детализации определён быть таким же, как у композита [ИД: @@|red_id@@|], но последнего в каталоге нет"), ("eng",  B.pack "for message template (ID: @@|rer_id@@|) representation required detailization level is referenced to be the same as of another composite, but referenced composite (ID: @@|red_id@@|) is missing")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        , ("E_PCLT_RPCSCE_DRLNE", (M.fromList [("rus",  B.pack "@@|drlne@@|"), ("eng",  B.pack "@@|drlne@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_RPCSCE##|" inner_cfg))+                        ]++-------------------------------------------------------------------------------++instance ShowAsPCSI AHSTR2LngTpl_Error where+        showAsPCSI ahs2pe = thePCSI "E_PCLT_AHS2PE" [("pclt_ahs2pe_err_details", PCSI_PV err_pcsi)]+           where+             err_pcsi =+                case ahs2pe of+                    RequiredCompositeIsMissing_AHS2PE rcim ->+                            addToPCSI+                                [ showAsPCSI rcim]+                                (empPCSI "E_PCLT_AHS2PE_MISSINGCOMPST")+                    ParseFailure_AHS2PE ll_errs_list ->+                                 thePCSI "E_PCLT_AHS2PE_PARSEFAIL" [("ll_errs_list", Indented_PV 4 $ PCSIList_PV (map showAsPCSI ll_errs_list) usualSeparatorInPCSIList)]++instance HasStaticRawPCLTs AHSTR2LngTpl_Error where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLT_AHS2PE", (M.fromList [("rus", B.pack "##|E_PCLT_AHS2PE_PREFIX##|@@|pclt_ahs2pe_err_details@@|."), ("eng", B.pack "##|E_PCLT_AHS2PE_PREFIX##|@@|pclt_ahs2pe_err_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_AHS2PE_PREFIX", (M.fromList [("rus", B.pack "Произошла ошибка при чтении шаблона (параметризуемого сообщения) в тексте. Ошибка: "), ("eng", B.pack "An error occured in ad-hoc parsing of text, that's supposed to be a template for message:")], str2PCLT_SDL Required_SDLM "##|E_PCLT_AHS2PE##|" inner_cfg))+                        , ("E_PCLT_AHS2PE_MISSINGCOMPST", (M.fromList [("rus", B.pack "##|E_PCLT_COMMONS_MISSINGCOMPST##|"), ("eng", B.pack "##|E_PCLT_COMMONS_MISSINGCOMPST##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_AHS2PE##|" inner_cfg))+                        , ("E_PCLT_AHS2PE_PARSEFAIL", (M.fromList [("rus", B.pack "данный текст не парсится в шаблон без ошибок. Список ошибок выданый парсером: @@|ll_errs_list@@|"), ("eng", B.pack "the given text won't parse into a template. Parse error(s): @@|ll_errs_list@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_AHS2PE##|" inner_cfg))+                        ]++---------------------------------------+data PCLTRawCatalog__Text_PCLT_MakeCatalog = PCLTRawCatalog__Text_PCLT_MakeCatalog+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_MakeCatalog where+     widenessOfStaticRawPCLTsSet _ = Module_RPSW+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                        [ getStaticRawPCLTs inner_cfg (undefined :: DRL_NormalizationError)+                        , getStaticRawPCLTs inner_cfg (undefined :: ReadPCSCatalogError)+                        , getStaticRawPCLTs inner_cfg (undefined :: AHSTR2LngTpl_Error)+                        ] -- i wish i knew an easy way how to achieve a smaller code of this by using a "map (getStaticRawPCLTs inner_cfg) [...]" function
+ Text/PCLT/MakeMessage.hs view
@@ -0,0 +1,510 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | Module around 'pcsi2text' function, which generates a message out of 'PCSI' and 'PCLT_Catalog'.+module Text.PCLT.MakeMessage where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.MyHelpers+import Data.Typeable+import Text.ConstraintedLBS+import Text.PCLT.Parser.AdvancedSepBy (SeparatedSectorMarker, MarkedChunkLength)+import Text.PCLT.Catalog+import Text.PCLT.CatalogMaths+import Text.PCLT.CommonTypes+import Text.PCLT.Config+import Text.PCLT.MakeCatalog+import Text.PCLT.PCSI+import Text.PCLT.SDL+import Text.PCLT.Template++-- | Error type for 'pcsi2text'.+data PCSI2Text_Error =+          RequiredCompositeIsMissing_P2TE            RequiredByRequirerCompositeIsMissing_PCLTE+        | RequiredCompositeLoclizationIsMissing_P2TE RequiredByRequirerCompositeIsMissing_PCLTE LanguageName+        | CompositionCycle_P2TE                      CompositionCycle_PCLTE+        | SDL_DeterminationFailure_P2TE              PCLT_ID SDL_DeterminationFailure+        -- | This error is possible only if program is wrong.+        | UnsupportedMarker_P2TE                     SeparatedSectorMarker Lazy.ByteString PCLT_ID LanguageName+        | NoValueForParameter_P2TE                   PCLT_ID LanguageName PCLT_ParamKey+        -- | Not used, reserved for future versions.+        | UnderAccordingParamReparsingFailure_P2TE   PCLT_ID LanguageName PCLT_ParamKey ReadPCSCatalogError+        -- | Not used, reserved for future versions.+        | ReparsingDepthMaxReached_P2TE              PCLT_ID LanguageName PCLT_ParamKey ReparsingDepth+        -- | Not used, reserved for future versions.+        | ReparsingLengthMaxReached_P2TE             PCLT_ID LanguageName PCLT_ParamKey ForInstaniationUsedChunkLength+        -- | No more free space in resulting 'CLBS'.+        | InstaniationLengthMaxReached_P2TE          PCLT_ID LanguageName ForInstaniationUsedChunkLength+      deriving (Show, Typeable)++-- | Error type for 'givenSDL_statisfies'.+data SDL_DeterminationFailure =+          RequiredCompositeIsMissing_SDLDF               RequiredByRequirerCompositeIsMissing_PCLTE+        -- | The SDL of template is specified+        -- (using 'PCLT_SDL_ToParamCompositeLink') to be the same as is+        -- one of a template, that must have been put+        -- under a parameter (using 'PCSI_PV'), but referenced parameter+        -- is missing in given 'PCSI'+        | MissingParam_SDLByParamCompositeLink_SDLDF     PCLT_CompositeKey PCLT_ParamKey+        -- | The SDL of template is specified+        -- (using 'PCLT_SDL_ToParamCompositeLink') to be the same as is+        -- one of a template, that must have been put+        -- under a parameter (using 'PCSI_PV'), but referenced parameter+        -- value is constructed using not 'PCSI_PV'.+        | WrongParamType_SDLByParamCompositeLink_SDLDF   PCLT_CompositeKey PCLT_ParamKey+        -- | The SDL of template is specified+        -- (using 'PCLT_SDL_ToParamCompositeLink') to be the same as is+        -- one of a template, that must have been put+        -- under a parameter (using 'PCSI_PV'), but the 'PCSI' under this+        -- parameter references some unknown (to catalog) template.+        | UnknownComposite_SDLByParamCompositeLink_SDLDF PCLT_CompositeKey PCLT_ParamKey PCLT_CompositeKey+        | SDLReferentialCycle_SDLDF                      PCLT_CompositeKey [PCLT_ID]+        | ErrornousSDL_SDLDF                             PCLT_CompositeKey PCLT_ErrornousSDL+      deriving (Show, Typeable)++-- | Type of 'PCSI2Text_Error'. Stripping arguments.+data PCSI2Text_Error_Type =+          RequiredCompositeIsMissing_P2TET+        | RequiredCompositeLoclizationIsMissing_P2TET+        | CompositionCycle_P2TET+        | SDL_DeterminationFailure_P2TET SDL_DeterminationFailure_Type+        | UnsupportedMarker_P2TET+        | NoValueForParameter_P2TET+        | UnderAccordingParamReparsingFailure_P2TET+        | ReparsingDepthMaxReached_P2TET+        | ReparsingLengthMaxReached_P2TET+        | InstaniationLengthMaxReached_P2TET++-- | Type of 'SDL_DeterminationFailure'. Stripping arguments.+data SDL_DeterminationFailure_Type =+          RequiredCompositeIsMissing_SDLDFT+        | MissingParam_SDLByParamCompositeLink_SDLDFT+        | WrongParamType_SDLByParamCompositeLink_SDLDFT+        | UnknownComposite_SDLByParamCompositeLink_SDLDFT+        | SDLReferentialCycle_SDLDFT+        | ErrornousSDL_SDLDFT++p2teType :: PCSI2Text_Error -> PCSI2Text_Error_Type+p2teType e =+      case e of+          RequiredCompositeIsMissing_P2TE            _       -> RequiredCompositeIsMissing_P2TET+          RequiredCompositeLoclizationIsMissing_P2TE _ _     -> RequiredCompositeLoclizationIsMissing_P2TET+          CompositionCycle_P2TE                      _       -> CompositionCycle_P2TET+          SDL_DeterminationFailure_P2TE              _ sdldf -> SDL_DeterminationFailure_P2TET (sdldfType sdldf)+          UnsupportedMarker_P2TE                     _ _ _ _ -> UnsupportedMarker_P2TET+          NoValueForParameter_P2TE                   _ _ _   -> NoValueForParameter_P2TET+          UnderAccordingParamReparsingFailure_P2TE   _ _ _ _ -> UnderAccordingParamReparsingFailure_P2TET+          ReparsingDepthMaxReached_P2TE              _ _ _ _ -> ReparsingDepthMaxReached_P2TET+          ReparsingLengthMaxReached_P2TE             _ _ _ _ -> ReparsingLengthMaxReached_P2TET+          InstaniationLengthMaxReached_P2TE          _ _ _   -> InstaniationLengthMaxReached_P2TET++sdldfType :: SDL_DeterminationFailure -> SDL_DeterminationFailure_Type+sdldfType e =+      case e of+          RequiredCompositeIsMissing_SDLDF                   _ -> RequiredCompositeIsMissing_SDLDFT+          MissingParam_SDLByParamCompositeLink_SDLDF       _ _ -> MissingParam_SDLByParamCompositeLink_SDLDFT+          WrongParamType_SDLByParamCompositeLink_SDLDF     _ _ -> WrongParamType_SDLByParamCompositeLink_SDLDFT+          UnknownComposite_SDLByParamCompositeLink_SDLDF _ _ _ -> UnknownComposite_SDLByParamCompositeLink_SDLDFT+          SDLReferentialCycle_SDLDF                        _ _ -> SDLReferentialCycle_SDLDFT+          ErrornousSDL_SDLDF                               _ _ -> ErrornousSDL_SDLDFT++-- | Template representation generation errors types abbreviations:+--+-- >       RequiredCompositeIsMissing_P2TET            -> "CM"+-- >       RequiredCompositeLoclizationIsMissing_P2TET -> "CLM"+-- >       CompositionCycle_P2TET                      -> "CC"+-- >       SDL_DeterminationFailure_P2TET       sdldft -> "SF" +++-- >           case sdldft of+-- >               RequiredCompositeIsMissing_SDLDFT               -> "(CM)"+-- >               MissingParam_SDLByParamCompositeLink_SDLDFT     -> "(LMP)"+-- >               WrongParamType_SDLByParamCompositeLink_SDLDFT   -> "(LWPT)"+-- >               UnknownComposite_SDLByParamCompositeLink_SDLDFT -> "(LUC)"+-- >               SDLReferentialCycle_SDLDFT                      -> "(CC)"+-- >               ErrornousSDL_SDLDFT                             -> "(ES)"+-- >       UnsupportedMarker_P2TET                     -> "UM"+-- >       NoValueForParameter_P2TET                   -> "NV"+-- >       UnderAccordingParamReparsingFailure_P2TET   -> "RF"+-- >       ReparsingDepthMaxReached_P2TET              -> "RDM"+-- >       ReparsingLengthMaxReached_P2TET             -> "RLM"+-- >       InstaniationLengthMaxReached_P2TET          -> "ILM"+shortOf_PCSI2Text_Error :: PCSI2Text_Error -> Lazy.ByteString+shortOf_PCSI2Text_Error e = B.pack $+        case p2teType e of+            RequiredCompositeIsMissing_P2TET            -> "CM"+            RequiredCompositeLoclizationIsMissing_P2TET -> "CLM"+            CompositionCycle_P2TET                      -> "CC"+            SDL_DeterminationFailure_P2TET       sdldft -> "SF" +++                case sdldft of+                    RequiredCompositeIsMissing_SDLDFT               -> "(CM)"+                    MissingParam_SDLByParamCompositeLink_SDLDFT     -> "(LMP)"+                    WrongParamType_SDLByParamCompositeLink_SDLDFT   -> "(LWPT)"+                    UnknownComposite_SDLByParamCompositeLink_SDLDFT -> "(LUC)"+                    SDLReferentialCycle_SDLDFT                      -> "(CC)"+                    ErrornousSDL_SDLDFT                             -> "(ES)"+            UnsupportedMarker_P2TET                     -> "UM"+            NoValueForParameter_P2TET                   -> "NV"+            UnderAccordingParamReparsingFailure_P2TET   -> "RF"+            ReparsingDepthMaxReached_P2TET              -> "RDM"+            ReparsingLengthMaxReached_P2TET             -> "RLM"+            InstaniationLengthMaxReached_P2TET          -> "ILM"++-- | Whenever representation generator can't make representation+-- for a template due to some error, it puts there (instead of representation)+-- an error marking ('pcsMarkingErrorPlaceholderWrapper') with an abbreviation (see 'shortOf_PCSI2Text_Error')+-- of error type and template ID.+includeAsAnError :: PCLT_InnerConfig -> PCSI2Text_Error -> String -> (Lazy.ByteString, ForInstaniationUsedChunkLength)+includeAsAnError cfg e s = let _err_marker_str = pcsMarkingErrorPlaceholderWrapper cfg+                               r = B.concat+                                        [ _err_marker_str+                                        , shortOf_PCSI2Text_Error e+                                        , B.pack ("->" ++ s)+                                        , _err_marker_str+                                        ]+                            in (r, B.length r)++-- | A test, if a given reciever's detalization level is enough+-- to represent a given 'PCSI'.+givenSDL_statisfies :: ShowDetalizationLevel -> PCSI -> PCLT_ShowDetalizationLevel -> PCLT_CatalogMap -> Either SDL_DeterminationFailure Bool+givenSDL_statisfies det_lev pcsi_0 req_sdl_0 cat_map = _givenSDL_statisfies pcsi_0 req_sdl_0 []+   where+     pcsi_0_id = pcsiTplID pcsi_0+     err31 rer    red =                     RequiredCompositeIsMissing_SDLDF $ RequiredByRequirerCompositeIsMissing_PCLTE rer $ RequiredCompositeIsMissing_PCLTE red+     err32 i_id   p_k =           MissingParam_SDLByParamCompositeLink_SDLDF i_id p_k+     err33 i_id   p_k =         WrongParamType_SDLByParamCompositeLink_SDLDF i_id p_k+     err34 i_id   p_k sc_id = UnknownComposite_SDLByParamCompositeLink_SDLDF i_id p_k sc_id+     err35 i_id   buf =                            SDLReferentialCycle_SDLDF i_id buf+     err36 i_id  esdl =                                   ErrornousSDL_SDLDF i_id esdl+     --------------------------------------------------------------------------------------+     _givenSDL_statisfies :: PCSI -> PCLT_ShowDetalizationLevel -> [PCLT_ID] -> Either SDL_DeterminationFailure Bool+     _givenSDL_statisfies pcsi req_sdl super_buf =+        let pcsi_id = pcsiTplID pcsi+            new_super_buf = pcsi_id : super_buf+         in case pcsi_id `elem` super_buf of+                True -> Left (err35 pcsi_id (pcsi_id : super_buf))+                False ->+                    case req_sdl of+                        PCLT_SDL sdl -> Right (det_lev >= sdl)+                        PCLT_SDL_ToTemplateLink k ->+                           case M.lookup k cat_map of+                               Nothing -> Left $ err31 pcsi_0_id k+                               Just s_pclt -> _givenSDL_statisfies+                                                        (pcsi {pcsiTplID = k} )+                                                        (pcltRequiredSDL s_pclt)+                                                        new_super_buf+                        PCLT_SDL_ToParamCompositeLink param_key ->+                           case M.lookup param_key $ pcsiParamsValsMap pcsi of+                               Nothing -> Left $ err32 pcsi_id param_key+                               Just p_val ->+                                        case p_val of+                                            PCSI_PV s_pcsi ->+                                                let s_pcsi_id = pcsiTplID s_pcsi+                                                 in case s_pcsi_id `elem` new_super_buf of+                                                        True -> Left (err35 s_pcsi_id (s_pcsi_id : new_super_buf))+                                                        False ->+                                                            case M.lookup (pcsiTplID s_pcsi) cat_map of+                                                                Nothing -> Left $ err34 pcsi_id param_key (pcsiTplID s_pcsi)+                                                                Just s_pclt -> givenSDL_statisfies+                                                                                        det_lev+                                                                                        s_pcsi+                                                                                        (pcltRequiredSDL s_pclt)+                                                                                        cat_map+                                            _ -> Left (err33 pcsi_id param_key)+                        PCLT_SDL_Errornous esdl -> Left (err36 pcsi_id esdl)+++type SpaceAvailableForPCSIInstaniation = MarkedChunkLength+type ForInstaniationUsedChunkLength    = MarkedChunkLength++-- | Wrapper around 'pcsi2text' for cases, when new 'CLBS' for output+-- is to be created. It's maximal length is set to be same+-- as configured in parameter 'pcsInstaniationResultMaxSize'+pcsi2new_text :: PCSI -> (ShowDetalizationLevel, LanguageName) -> PCLT_Catalog -> (StdOut_CLBS, [ErrorWithPCSCatalog PCSI2Text_Error])+pcsi2new_text _pcsi (det_lev, lng) pcs_catalog = pcsi2text (newCLBS $ catInstMaxLen pcs_catalog) _pcsi (det_lev, lng) pcs_catalog++-- | Make a representation out of 'PCSI' in specified detailization level,+-- in specified language, using specified catalog. And append result+-- to a specified 'CLBS'.+pcsi2text :: StdOut_CLBS -> PCSI -> (ShowDetalizationLevel, LanguageName) -> PCLT_Catalog -> (StdOut_CLBS, [ErrorWithPCSCatalog PCSI2Text_Error])+pcsi2text init_clbs _pcsi (det_lev, lng) pcs_catalog =+                let (clbs, errs_list) = _pcsi2text (pcsiTplID _pcsi) _pcsi gen_cat_map [] (init_clbs, 0)+                    errs_last_add =+                        case clbsFinalized_isit clbs of+                            True  -> [err12]+                            False -> []+                 in ( clbs+                    , map (ErrorWithPCSCatalog (pcltcCatalogID pcs_catalog)) (errs_last_add ++ errs_list)+                    )+        where+           gen_cat_map = pcltcCatalogMap pcs_catalog+           cfg = pcltcInnerConfig pcs_catalog+           _allow_untmpl_msgs           = pcsAllowUntemplatedMessages             cfg+           _allow_lnguntmpl_msgs        = pcsAllowUntemplatedLocalizationsOfMessages cfg+           _show_adhoc_params_emp       = pcsShowAdhocParamsInResultOfUntemplated cfg+           _insuficient_det_lev_str     = pcsInsuficientDetLevelPlaceholder       cfg+           _insuficient_det_lev_str_len = B.length _insuficient_det_lev_str+           _insuficient_det_lev__incl   = (_insuficient_det_lev_str, _insuficient_det_lev_str_len)+           _inst_max_size               = pcsInstaniationResultMaxSize            cfg+           _reparsing_depth_max         = pcsReparsingDepthMax                    cfg+           _reparsable_text_size_max    = pcsReparseParameterContentMaxSize       cfg+           _newline_lbs                 = pcsNewlineLBS                           cfg+           _newline_lbs_len             = B.length _newline_lbs+           _allow_sdl_det_fail          = pcsAllowFailureToDetermineSDL_parseIdByModusMargin cfg+           errMarkStr           err key = includeAsAnError cfg err key+           err0  msg_id buf = CompositionCycle_P2TE $ CompositionCycle_PCLTE msg_id buf+           err1     rer red = RequiredCompositeIsMissing_P2TE            (RequiredByRequirerCompositeIsMissing_PCLTE rer $ RequiredCompositeIsMissing_PCLTE red)+           err2     rer red = RequiredCompositeLoclizationIsMissing_P2TE (RequiredByRequirerCompositeIsMissing_PCLTE rer $ RequiredCompositeIsMissing_PCLTE red) lng+           err3  rer  sdl_e = SDL_DeterminationFailure_P2TE rer sdl_e+           err6 marker t_chunk tpl_id = UnsupportedMarker_P2TE marker t_chunk tpl_id lng+           err8  tpl_id p_k    = NoValueForParameter_P2TE tpl_id lng p_k+           err9  tpl_id p_k re = UnderAccordingParamReparsingFailure_P2TE tpl_id lng p_k re+           err10 tpl_id p_k    = ReparsingDepthMaxReached_P2TE tpl_id lng p_k _reparsing_depth_max+           err11 tpl_id p_k    = ReparsingLengthMaxReached_P2TE tpl_id lng p_k _reparsable_text_size_max+           err12 = InstaniationLengthMaxReached_P2TE (pcsiTplID _pcsi) lng (clbsMaxLen init_clbs)+           --------------------------------+           --------------------------------+           _pcsi2text :: PCLT_ID+                      -> PCSI+                      -> PCLT_CatalogMap+                      -> [PCLT_ID]+                      -> (StdOut_CLBS, ReparsingDepth)+                      -> (StdOut_CLBS, [PCSI2Text_Error])+           _pcsi2text refere_pcsi_id pcsi composites_map super_buf (clbs, reparsing_depth) =+                let pcsi_id  = pcsiTplID pcsi+                    pcsi_pvm = pcsiParamsValsMap pcsi+                    returnJustErr :: PCSI2Text_Error -> String -> (StdOut_CLBS, [PCSI2Text_Error])+                    returnJustErr _err k = (errMarkStr _err k `addToCLBS_1` clbs, [_err])+                    returnInsuficientSDL errs_list = (_insuficient_det_lev__incl `addToCLBS_1` clbs, errs_list)+                    decontexted_msg __req_det_lev =+                            let _req_det_lev = PCLT_SDL __req_det_lev+                                err_of_statisfies_0 = givenSDL_statisfies det_lev pcsi _req_det_lev gen_cat_map+                                (err_of_statisfies_1, errs0) =+                                        case err_of_statisfies_0 of+                                            Right      _ -> (err_of_statisfies_0, [])+                                            Left sdl_err -> ( case _allow_sdl_det_fail of+                                                                  True -> Right (det_lev == InfinitelyBig_SDL)+                                                                  False -> err_of_statisfies_0+                                                            , [err3 pcsi_id sdl_err]+                                                            )+                             in case err_of_statisfies_1 of+                                    Left     sdl_err -> returnJustErr (err3 pcsi_id sdl_err) pcsi_id+                                    Right statisfies ->+                                          case _show_adhoc_params_emp && statisfies of -- && (null super_buf)+                                              False -> returnInsuficientSDL errs0+                                              True  ->+                                                  let _header = B.concat [B.pack pcsi_id, B.pack " {"]+                                                      _header_len = B.length _header+                                                      clbs2 = (_header, _header_len) `addToCLBS_1` clbs+                                                      -- fold_f :: [(CLBS, [PCSI2Text_Error])]+                                                      fold_f = (\ (p_key, p_val) (clbs_accum, errs_accum) ->+                                                                          let (new_clbs_accum, errs_list_addition) =+                                                                                   instaniateParam+                                                                                        p_key+                                                                                        pcsi { pcsiParamsValsMap = M.singleton+                                                                                                  p_key $+                                                                                                  PVList_PV+                                                                                                        [ NewLine_PV+                                                                                                        , PlainText_PV (" @@@ " ++ p_key ++ ": ")+                                                                                                        , Indented_PV 4 p_val+                                                                                                        ]+                                                                                             }+                                                                                        (clbs_accum, undefined)+                                                                           in case clbsFinalized_isit clbs_accum of+                                                                                  True  -> (clbs_accum, errs_accum)+                                                                                  False ->+                                                                                      ( new_clbs_accum+                                                                                      , errs_accum ++ errs_list_addition+                                                                                      )+                                                               )+                                                      (clbs3, errs1) = foldr fold_f (clbs2, errs0) (M.toList pcsi_pvm)+                                                   in ( addToCLBS_1+                                                                (B.pack "}", 1) $+                                                                case M.null pcsi_pvm of+                                                                    False -> (_newline_lbs, _newline_lbs_len) `addToCLBS_1` clbs3+                                                                    True -> clbs3+                                                      , errs1+                                                      )+                 in case pcsi_id `elem` super_buf of+                        True  -> returnJustErr (err0 pcsi_id super_buf) pcsi_id+                        False ->+                            case clbsFinalized_isit clbs of+                                True  -> (clbs, [])+                                False ->+                                    case M.lookup pcsi_id composites_map of+                                        Nothing   ->+                                                case _allow_untmpl_msgs of+                                                    True  -> decontexted_msg InfinitelyBig_SDL+                                                    False -> returnJustErr (err1 refere_pcsi_id pcsi_id) pcsi_id+                                        Just pclt ->+                                                case M.lookup lng (pcltLocalizationsMap pclt) of+                                                    Nothing -> case _allow_lnguntmpl_msgs of+                                                                   True  -> decontexted_msg InfinitelyBig_SDL+                                                                   False -> returnJustErr (err2 refere_pcsi_id pcsi_id) pcsi_id+                                                    Just ldt ->+                                                            let subcomposites = ldtSubcompositesMap ldt+                                                                err_of_statisfies_0 = givenSDL_statisfies det_lev pcsi (pcltRequiredSDL pclt) gen_cat_map+                                                                (err_of_statisfies_1, errs0) =+                                                                        case err_of_statisfies_0 of+                                                                            Right     _ -> (err_of_statisfies_0, [])+                                                                            Left  sdl_e -> ( case _allow_sdl_det_fail of+                                                                                               True  -> Right (det_lev == InfinitelyBig_SDL)+                                                                                               False -> err_of_statisfies_0+                                                                                         , [err3 pcsi_id sdl_e]+                                                                                         )+                                                             in case err_of_statisfies_1 of+                                                                    Left  sdl_e -> returnJustErr (err3 (pcsiTplID pcsi) sdl_e) pcsi_id+                                                                    Right False -> returnInsuficientSDL errs0+                                                                    Right  True ->+                                                                          let foldr_f =+                                                                                (\ (clbs_accum, errs_accum) (ldtm, str, len)  ->+                                                                                        let (new_clbs_accum, errs_add) =+                                                                                                instaniateTplChunk+                                                                                                        subcomposites+                                                                                                        (ldtm, str, len)+                                                                                                        pcsi+                                                                                                        super_buf+                                                                                                        (clbs_accum, reparsing_depth)+                                                                                         in ( new_clbs_accum+                                                                                            , errs_accum ++ errs_add+                                                                                            )+                                                                                )+                                                                           in foldl foldr_f (clbs, errs0) (ldtAbstractedString ldt)+                where+                   -----------------------------------------------------+                   instaniateTplChunk :: PCLT_CatalogMap+                                      -> (PCS_SpecificMarkings, Lazy.ByteString, MarkedChunkLength)+                                      -> PCSI -> [PCLT_ID]+                                      -> (StdOut_CLBS, ReparsingDepth)+                                      -> (StdOut_CLBS, [PCSI2Text_Error])+                   instaniateTplChunk subcomposites (ldtm, lbs, len) pcsi super_buf (clbs, reparsing_depth) =+                        let str = B.unpack lbs+                        in case clbsFinalized_isit clbs of+                               True  -> (clbs, [])+                               False ->+                                   case ldtm of+                                       PlainText_LngTplM -> ((lbs, len) `addToCLBS_1` clbs, [])+                                       Parameter_LngTplM -> let param_key = str+                                                             in instaniateParam param_key pcsi (clbs, reparsing_depth)+                                       Composite_LngTplM -> let sub_pcsi_id = str+                                                                sub_pcsi = pcsi { pcsiTplID = sub_pcsi_id }+                                                             in _pcsi2text (pcsiTplID pcsi) sub_pcsi subcomposites (pcsiTplID pcsi : super_buf) (clbs, reparsing_depth)+                                       Unsupported_LngTplM ssm ->+                                                            let _err = err6 ssm lbs (pcsiTplID pcsi)+                                                             in (errMarkStr _err str `addToCLBS_1` clbs, [_err])+                   ------------------------------------------------------+                   instaniateParam :: PCLT_ParamKey+                                   -> PCSI+                                   -> (StdOut_CLBS, ReparsingDepth)+                                   -> (StdOut_CLBS, [PCSI2Text_Error])+                   instaniateParam param_key pcsi (clbs, reparsing_depth) =+                               let pcsi_pvm = pcsiParamsValsMap pcsi+                                   pclt_id  = pcsiTplID pcsi+                                   referer_pcsi_id = pclt_id ++ "<p: " ++ param_key ++ ">"+                                in case M.lookup param_key pcsi_pvm of+                                       Nothing        -> let _err = err8 pclt_id param_key+                                                          in (errMarkStr _err param_key `addToCLBS_1` clbs, [_err])+                                       Just _pcsi_ipv ->+                                           let _processParamVal :: PCLT_ParamVal -> CLBS -> (CLBS, [PCSI2Text_Error])+                                               _processParamVal pcsi_ipv sub_clbs =+                                                        case clbsFinalized_isit sub_clbs of+                                                            True  -> (sub_clbs, [])+                                                            False -> _processParamVal_sub+                                                  where+                                                    _processParamVal_sub :: (CLBS, [PCSI2Text_Error])+                                                    _processParamVal_sub = case pcsi_ipv of+                                                       Nothing_PV              -> (sub_clbs, [])+                                                       NewLine_PV              -> ((_newline_lbs, _newline_lbs_len) `addToCLBS_1` sub_clbs, [])+                                                       Indented_PV i pcsi_iipv -> let fr_clbs = freeSpaceCLBS sub_clbs+                                                                                      (notind_clbs, _errs_list) = _processParamVal pcsi_iipv fr_clbs+                                                                                      ind_clbs = insertInsteadOf_inCLBS (_newline_lbs, B.concat [_newline_lbs, B.replicate (fromIntegral i) ' ']) notind_clbs+                                                                                   in (ind_clbs `addToCLBS_2` sub_clbs, _errs_list)+                    {- this is an experimental part    Reparsable_PV rp_pv rp_params ->+                       curently doesn't work               let dest_clbs = newCLBS _reparsable_text_size_max+                                                                (clbs_for_reparse, _errs_list_0) =+                                                                        _processParamVal+                                                                                rp_pv+                                                                                dest_clbs -- in newer version must get rid of this workaround by exploiting laziness at it's 100%... for that will need to get rid of all lengths here.+                                                                _errs_list_1 =+                                                                      (++)+                                                                        _errs_list_0+                                                                        (case clbsFinalized_isit clbs_for_reparse of+                                                                             True  -> [err11 (pcsiTplID pcsi) param_key]+                                                                             False -> []+                                                                        )+                                                                reparse_willwe = reparsing_depth < _reparsing_depth_max+                                                                (add_to_sub_clbs, add_errs_list) =+                                                                        case reparse_willwe of+                                                                            False -> (clbs_for_reparse, _errs_list_1 ++ [err10 pclt_id param_key])+                                                                            True  ->+                                                                                let rp_pclt_id = "<<REPARSE:" ++ pclt_id ++ "(" ++ param_key ++ ")>>"+                                                                                    err_or_pclt = str2pclt+                                                                                                        ( rp_pclt_id+                                                                                                        , PCLT_SDL Zero_SDL+                                                                                                        )+                                                                                                        (lng, clbsLBS clbs_for_reparse)+                                                                                                        pcs_catalog+                                                                                 in case err_or_pclt of+                                                                                        Left   ar_err -> let (ErrorWithPCSCatalog _ re) = ar_err+                                                                                                          in (clbs_for_reparse, _errs_list_1 ++ [err9 pclt_id param_key re])+                                                                                        Right re_pclt ->+                                                                                             let (result_clbs, _errs_list_2) =+                                                                                                        _pcsi2text+                                                                                                                (referer_pcsi_id ++ "<r>")+                                                                                                                (thePCSI rp_pclt_id (M.toList rp_params))+                                                                                                                (M.insert rp_pclt_id re_pclt gen_cat_map)+                                                                                                                []+                                                                                                                (sub_clbs, reparsing_depth + 1)+                                                                                              in (result_clbs, _errs_list_1 ++ _errs_list_2)+                                                              in (add_to_sub_clbs `addToCLBS_2` sub_clbs, add_errs_list) -}+                                                       PlainText_PV     v -> let v_lbs = B.pack v in ((v_lbs, B.length v_lbs) `addToCLBS_1` sub_clbs, [])+                                                       PlainTextLBS_PV  v -> ((v, B.length v) `addToCLBS_1` sub_clbs, [])+                                                       PCSI_PV    pcsi_pv -> _pcsi2text referer_pcsi_id pcsi_pv gen_cat_map [] (sub_clbs, reparsing_depth)+                                                       PCSIList_PV pcsi_l separator_pv ->+                                                                let (separator_clbs, errs_list_0) = _processParamVal separator_pv (freeSpaceCLBS sub_clbs)+                                                                    (result_clbs, errs_list, _) =+                                                                        foldl+                                                                            (\ (clbs_accum0, errs_accum, i) pcsi_fl ->+                                                                                   case clbsFinalized_isit clbs_accum0 of+                                                                                       True  -> (clbs_accum0, errs_accum, i + 1)+                                                                                       False -> let clbs_accum2 =+                                                                                                        case i > 1 of+                                                                                                            True  -> separator_clbs `addToCLBS_2` clbs_accum0+                                                                                                            False -> clbs_accum0+                                                                                                    pcsi_fl2 = pcsi_fl {+                                                                                                                pcsiParamsValsMap =+                                                                                                                    sumPCSI_PVMs+                                                                                                                        (pcsiParamsValsMap pcsi_fl)+                                                                                                                        (M.fromList [("__row_idx", PlainText_PV $ show i)])+                                                                                                                }+                                                                                                    (clbs_accum3, errs_add) = _processParamVal (PCSI_PV pcsi_fl2) clbs_accum2+                                                                                                 in (clbs_accum3, errs_accum ++ errs_add, i + 1)+                                                                            )+                                                                            (sub_clbs, errs_list_0, 1)+                                                                            pcsi_l+                                                                 in (result_clbs, errs_list)+                                                       PVList_PV pv_list ->+                                                                let (result_clbs, errs_list, _) =+                                                                        foldl+                                                                            (\ (clbs_accum, errs_accum, i) pv_fl ->+                                                                                   case clbsFinalized_isit clbs_accum of+                                                                                       True  -> (clbs_accum, errs_accum, i+1)+                                                                                       False -> let (clbs_new_accum, errs_add) = _processParamVal pv_fl clbs_accum+                                                                                                 in (clbs_new_accum, errs_accum ++ errs_add, i + 1)+                                                                            )+                                                                            (sub_clbs, [], 1)+                                                                            pv_list+                                                                 in (result_clbs, errs_list)++                                            ----------------------------+                                         in _processParamVal _pcsi_ipv clbs+           ------------------------------------------------------
+ Text/PCLT/MakeMessage2.hs view
@@ -0,0 +1,123 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | Addition to "Text.PCLT.MakeMessage" module. Some wrappers around 'pcsi2text' function.+module Text.PCLT.MakeMessage2 where++import Data.Int+import Data.MyHelpers+import Text.ConstraintedLBS+import Text.PCLT.Catalog+import Text.PCLT.CommonTypes+import Text.PCLT.Config+import Text.PCLT.MakeMessage+import Text.PCLT.MakeMessage__+import Text.PCLT.PCSI+import Text.PCLT.SDL+import Text.PCLT.ShowAsPCSI++-- | Wrapper around 'pcsi2text_plus_errs_1' for cases, when new 'CLBS'+-- is to be created. It's maximal length is set to be same+-- as configured in parameter 'pcsInstaniationResultMaxSize'+pcsi2new_text_plus_errs_1 :: PCSI -> (ShowDetalizationLevel, LanguageName) -> PCLT_Catalog -> StdOutAndErr_CLBS+pcsi2new_text_plus_errs_1 pcsi (sdl, lng) msg_tpls_ctlg =+        pcsi2text_plus_errs_1 (newCLBS $ catInstMaxLen msg_tpls_ctlg) pcsi (sdl, lng) msg_tpls_ctlg+-- |+--+-- (1) generates message from given PCSI+--+-- (2) generates representation of errors list (that occurred, when doing step (1))+--+-- (3) generates representation of errors list (that occurred, when doing step (2))+--+-- (4) appends text result of step (3) to given CLBS+--+-- (5) appends text result of step (2) to given CLBS+--+-- (6) appends text result of step (1) to given CLBS+pcsi2text_plus_errs_1 :: StdOutAndErr_CLBS -> PCSI -> (ShowDetalizationLevel, LanguageName) -> PCLT_Catalog -> StdOutAndErr_CLBS+pcsi2text_plus_errs_1 _init_clbs pcsi (sdl, lng) msg_tpls_ctlg =+              let init_clbs = freeSpaceCLBS _init_clbs+                  (result_clbs, errs_list1) = pcsi2text+                                                init_clbs+                                                pcsi+                                                (sdl, lng)+                                                msg_tpls_ctlg+                  (errs_clbs, errs_list2) =+                                  case null errs_list1 of+                                      True  -> (init_clbs, [])+                                      False -> pcsi2text+                                                        init_clbs+                                                        (thePCSI "E_PCLT_P2TE_LIST" [("errors_list", Indented_PV 4 $ PCSIList_PV (map showAsPCSI errs_list1) usualSeparatorInPCSIList)])+                                                        (sdl, lng)+                                                        msg_tpls_ctlg+                  (errs_errs_clbs, _) =+                                  case null errs_list2 of+                                      True  -> (init_clbs, [])+                                      False -> pcsi2text+                                                        init_clbs+                                                        (thePCSI "E_PCLT_P2TE_LIST" [("errors_list", Indented_PV 4 $ PCSIList_PV (map showAsPCSI errs_list2) usualSeparatorInPCSIList)])+                                                        (sdl, lng)+                                                        msg_tpls_ctlg+               in (result_clbs `addToCLBS_2` (errs_clbs `addToCLBS_2` (errs_errs_clbs `addToCLBS_2` _init_clbs)))++---------------------------------------------------------------------------------------++-- | Wrapper around 'pcsi2text_plus_errs_2' for cases, when new 'CLBS's+-- are to be created:+--+-- * One - for representation of normal output. It's maximal length is set+-- to be same as configured in parameter 'pcsInstaniationResultMaxSize'+--+-- * Another - for representation of errors. It's maximal size is specified+-- in the first argument of function.+pcsi2new_text_plus_errs_2 :: Int64 -> PCSI -> (ShowDetalizationLevel, LanguageName) -> PCLT_Catalog -> (StdOut_CLBS, StdErr_CLBS)+pcsi2new_text_plus_errs_2 inst_max_len pcsi (sdl, lng) msg_tpls_ctlg =+        pcsi2text_plus_errs_2 (newCLBS $ catInstMaxLen msg_tpls_ctlg, newCLBS inst_max_len) pcsi (sdl, lng) msg_tpls_ctlg++-- |+--+-- (1) generates message from given PCSI+--+-- (2) appends text result of step (1) to given CLBS_1+--+-- (3) generates representation of errors list (that occurred, when doing step (1))+--+-- (4) generates representation of errors list (that occurred, when doing step (3))+--+-- (5) appends text result of step (4) to given CLBS_2+--+-- (6) appends text result of step (3) to given CLBS_2+pcsi2text_plus_errs_2 :: (StdOut_CLBS, StdErr_CLBS) -> PCSI -> (ShowDetalizationLevel, LanguageName) -> PCLT_Catalog -> (StdOut_CLBS, StdErr_CLBS)+pcsi2text_plus_errs_2 (init_clbs, _errs_init_clbs) pcsi (sdl, lng) msg_tpls_ctlg =+              let errs_init_clbs = freeSpaceCLBS _errs_init_clbs+                  (result_clbs, errs_list1) = pcsi2text+                                                 init_clbs+                                                 pcsi+                                                 (sdl, lng)+                                                 msg_tpls_ctlg+                  (errs_clbs, errs_list2) =+                                  case null errs_list1 of+                                      True  -> (errs_init_clbs, [])+                                      False -> pcsi2text+                                                        init_clbs+                                                        (thePCSI "E_PCLT_P2TE_LIST" [("errors_list", Indented_PV 4 $ PCSIList_PV (map showAsPCSI errs_list1) usualSeparatorInPCSIList)])+                                                        (sdl, lng)+                                                        msg_tpls_ctlg+                  (errs_errs_clbs, _) =+                                  case null errs_list2 of+                                      True  -> (errs_init_clbs, [])+                                      False -> pcsi2text+                                                        init_clbs+                                                        (thePCSI "E_PCLT_P2TE_LIST" [("errors_list", Indented_PV 4 $ PCSIList_PV (map showAsPCSI errs_list2) usualSeparatorInPCSIList)])+                                                        (sdl, lng)+                                                        msg_tpls_ctlg+               in (result_clbs, errs_clbs `addToCLBS_2` (errs_errs_clbs `addToCLBS_2` errs_init_clbs))
+ Text/PCLT/MakeMessage__.hs view
@@ -0,0 +1,168 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# OPTIONS_HADDOCK hide #-}++module Text.PCLT.MakeMessage__ where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.MyHelpers+import Text.PCLT.SH__+import Text.PCLT.MakeMessage+import Text.PCLT.Catalog__+import Text.PCLT.MakeCatalog__+import Text.PCLT.Template__+import Text.PCLT.ShowAsPCSI__++-------------------------------------------++instance ShowAsPCSI PCSI2Text_Error where+        showAsPCSI p2te = thePCSI "E_PCLT_P2TE"+                                      [ ("short_err_mark", PlainText_PV $ B.unpack $ shortOf_PCSI2Text_Error p2te)+                                      , ("pclt_p2te_err_details", PCSI_PV err_pcsi)+                                      ]+          where+             err_pcsi =+                case p2te of+                    RequiredCompositeIsMissing_P2TE rrcim ->+                            addToPCSI+                               [showAsPCSI rrcim]+                               (   empPCSI "E_PCLT_P2TE_MISSINGCOMPST")+                    RequiredCompositeLoclizationIsMissing_P2TE rrcim lng ->+                            addToPCSI+                               [showAsPCSI rrcim]+                               (   thePCSI "E_PCLT_P2TE_MISSINGLNGCOMPST" [("lng", PlainText_PV lng)])+                    CompositionCycle_P2TE cc ->+                            addToPCSI+                               [showAsPCSI cc]+                               (   empPCSI "E_PCLT_P2TE_COMPCYCL")+                    SDL_DeterminationFailure_P2TE tpl_id sdldf ->+                            addToPCSI+                               [showAsPCSI sdldf]+                               (   thePCSI "E_PCLT_P2TE_SDLDF" [("tpl_id" , PlainText_PV tpl_id)])+                    UnsupportedMarker_P2TE                     ssm contents tpl_id lng ->+                                thePCSI "E_PCLT_P2TE_USUPMARK"   [ ("tpl_id"  , PlainText_PV tpl_id)+                                                                 , ("lng"     , PlainText_PV lng)+                                                                 , ("contents", PlainTextLBS_PV $ truncLiteraryLBS contents 15)+                                                                 , ("ssm"     , PCSI_PV $ showAsPCSI $ SeparatedSectorMarker_PCSIWrapped ssm)+                                                                 ]+                    NoValueForParameter_P2TE                   tpl_id lng param_id ->+                                thePCSI "E_PCLT_P2TE_NOPARAMVAL" [ ("tpl_id"  , PlainText_PV tpl_id)+                                                                     , ("lng"     , PlainText_PV lng)+                                                                     , ("param_id", PlainText_PV param_id)+                                                                     ]+                    UnderAccordingParamReparsingFailure_P2TE        tpl_id lng param_id rpcsce ->+                                thePCSI "E_PCLT_P2TE_REPRSFAIL"  [ ("tpl_id"  , PlainText_PV tpl_id)+                                                                 , ("lng"     , PlainText_PV lng)+                                                                 , ("param_id", PlainText_PV param_id)+                                                                 , ("rpcsce"  , PCSI_PV $ showAsPCSI rpcsce)+                                                                 ]+                    ReparsingDepthMaxReached_P2TE                   tpl_id lng param_id reparsing_depth ->+                                thePCSI "E_PCLT_P2TE_REPRSDEPTH" [ ("tpl_id"  , PlainText_PV tpl_id)+                                                                 , ("lng"     , PlainText_PV lng)+                                                                 , ("param_id", PlainText_PV param_id)+                                                                 , ("reparsing_depth", PlainText_PV $ show reparsing_depth)+                                                                 ]+                    ReparsingLengthMaxReached_P2TE                  tpl_id lng param_id max_len ->+                                thePCSI "E_PCLT_P2TE_REPRSLEN"   [ ("tpl_id"  , PlainText_PV tpl_id)+                                                                 , ("lng"     , PlainText_PV lng)+                                                                 , ("param_id", PlainText_PV param_id)+                                                                 , ("max_len", PlainText_PV $ show max_len)+                                                                 ]+                    InstaniationLengthMaxReached_P2TE               tpl_id lng max_len ->+                                thePCSI "E_PCLT_P2TE_INSTLEN"    [ ("tpl_id"  , PlainText_PV tpl_id)+                                                                 , ("lng"     , PlainText_PV lng)+                                                                 , ("max_len", PlainText_PV $ show max_len)+                                                                 ]++instance HasStaticRawPCLTs PCSI2Text_Error where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLT_P2TE", (M.fromList [("rus",  B.pack "##|E_PCLT_P2TE_PREFIX##|@@|pclt_p2te_err_details@@|."), ("eng",  B.pack "##|E_PCLT_P2TE_PREFIX##|@@|pclt_p2te_err_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_P2TE_PREFIX", (M.fromList [("rus",  B.pack "Произошла ошибка (@@|short_err_mark@@|) при реализации сообщения из шаблона: "), ("eng",  B.pack "An error (@@|short_err_mark@@|) occurred, when trying to realize a message from a template: ")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_MISSINGCOMPST", (M.fromList [("rus",  B.pack "##|E_PCLT_COMMONS_MISSINGCOMPSTBYRER##|"), ("eng",  B.pack "##|E_PCLT_COMMONS_MISSINGCOMPSTBYRER##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_MISSINGLNGCOMPST", (M.fromList [("rus",  B.pack "(для языка \"@@|lng@@|\") ##|E_PCLT_COMMONS_MISSINGCOMPSTBYRER##|"), ("eng",  B.pack "(for language \"@@|lng@@|\") ##|E_PCLT_COMMONS_MISSINGCOMPSTBYRER##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_COMPCYCL", (M.fromList [("rus",  B.pack "##|E_PCLT_COMMONS_CCYCL##|"), ("eng",  B.pack "##|E_PCLT_COMMONS_CCYCL##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_SDLDF", (M.fromList [("rus",  B.pack "##|E_PCLT_SDLDF##|"), ("eng",  B.pack "##|E_PCLT_SDLDF##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_USUPMARK", (M.fromList [("rus", B.pack "неизвестный маркер обнаружен в шаблоне [ИД: @@|tpl_id@@|; язык: \"@@|lng@@|\"]. @@|ssm@@| Содержимое под маркером: @@|contents@@|"), ("eng", B.pack "unsupported marker appeara in the template [ID: @@|tpl_id@@|; language: \"@@|lng@@|\"]. @@|ssm@@| Marked text chunk: @@|contents@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_NOPARAMVAL", (M.fromList [("rus",  B.pack "для параметра \"@@|param_id@@|\" к реализации шаблона [ИД: @@|tpl_id@@|; язык: \"@@|lng@@|\"] не указано значение"), ("eng",  B.pack "no value specified for parameter \"@@|param_id@@|\" of template [ID: @@|tpl_id@@|; lng: \"@@|lng@@|\"]")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_REPRSFAIL", (M.fromList [("rus",  B.pack "произошла ошибка при репарсинге значения параметра \"@@|param_id@@|\" при реализации шаблона [ИД: @@|tpl_id@@|; язык: \"@@|lng@@|\"]. Ошибка: @@|rpcsce@@|"), ("eng",  B.pack "an error occurred, when reparsing a value specified for parameter \"@@|param_id@@|\" of template [ID: @@|tpl_id@@|; lng: \"@@|lng@@|\"]: @@|rpcsce@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_REPRSDEPTH", (M.fromList [("rus",  B.pack "достигнута максимальная глубина репарсинга (@@|reparsing_depth@@|). Дальнейшее углубление остановлено на репарсинге значения параметра \"@@|param_id@@|\" при реализации шаблона [ИД: @@|tpl_id@@|; язык: \"@@|lng@@|\"]"), ("eng",  B.pack "reparsing depth maximum (@@|reparsing_depth@@|) reached, - halted a reparsing of a value specified for parameter \"@@|param_id@@|\" of template [ID: @@|tpl_id@@|; lng: \"@@|lng@@|\"]")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_REPRSLEN", (M.fromList [("rus",  B.pack "достигнута максимальная длина (@@|max_len@@|) сторки подготавливаемой к репарсингу, при репарсинге значения параметра \"@@|param_id@@|\" при реализации шаблона [ИД: @@|tpl_id@@|; язык: \"@@|lng@@|\"]"), ("eng",  B.pack "the text, that is to be reparsed, length maximum (@@|max_len@@|) reached, when reparsing a value specified for parameter \"@@|param_id@@|\" of template [ID: @@|tpl_id@@|; lng: \"@@|lng@@|\"]")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        , ("E_PCLT_P2TE_INSTLEN", (M.fromList [("rus",  B.pack "достигнута максимальная длина (@@|max_len@@|) реализации сообщения из шаблона [ИД: @@|tpl_id@@|; язык: \"@@|lng@@|\"]"), ("eng",  B.pack "the realization length maximum (@@|max_len@@|) is reached, when realizing template [ID: @@|tpl_id@@|; lng: \"@@|lng@@|\"]")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE##|" inner_cfg))+                        -- ------------!!!+                        , ("E_PCLT_P2TE_LIST", (M.fromList [("rus", B.pack "##|E_PCLT_P2TE_LIST_PREFIX##|\n@@|errors_list@@|\n##|E_PCLT_P2TE_LIST_POSTFIX##|"), ("eng", B.pack "##|E_PCLT_P2TE_LIST_PREFIX##|\n@@|errors_list@@|\n##|E_PCLT_P2TE_LIST_POSTFIX##|")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_P2TE_LIST_PREFIX", (M.fromList [("rus", B.pack "----СЛЕЛУЮЩИЕ-ОШИБКИ-ВОЗНИКЛИ-ПРИ-ГЕНЕРАЦИИ-СООБЩЕНИЙ ИЗ-ШАБЛОНОВ----\n"), ("eng", B.pack "----FOLLOWING-ERRORS-OCCURED-WHEN-GENERATING-MESSAGES-FROM-TEMPLATES----------\n")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE_LIST##|" inner_cfg))+                        , ("E_PCLT_P2TE_LIST_POSTFIX", (M.fromList [("rus", B.pack "\n----------------\n----ОШИБКИ-ГЕНЕРАТОРА-СООБЩЕНИЙ-[END]----------\n"), ("eng", B.pack "\n----------------\n----MESSAGES-GENERATOR-ERRORS-[END]----------\n")], str2PCLT_SDL Required_SDLM "##|E_PCLT_P2TE_LIST##|" inner_cfg))+                        ]++---------------------------------------------++instance ShowAsPCSI SDL_DeterminationFailure where+        showAsPCSI sdldf = thePCSI "E_PCLT_SDLDF" [("pclt_sdldf_err_details", PCSI_PV err_pcsi)]+           where+             err_pcsi =+                case sdldf of+                    RequiredCompositeIsMissing_SDLDF rrcim ->+                            addToPCSI+                               [showAsPCSI rrcim]+                               (   empPCSI "E_PCLT_SDLDF_MISSCMPST")+                    MissingParam_SDLByParamCompositeLink_SDLDF     tpl_id param_id  ->+                                thePCSI "E_PCLT_SDLDF_MISSPARAM"    [ ("tpl_id"     , PlainText_PV tpl_id)+                                                                    , ("param_id"   , PlainText_PV param_id)+                                                                    ]+                    WrongParamType_SDLByParamCompositeLink_SDLDF   tpl_id param_id  ->+                                thePCSI "E_PCLT_SDLDF_WRNGPRMTYP"   [ ("tpl_id"     , PlainText_PV tpl_id)+                                                                    , ("param_id"   , PlainText_PV param_id)+                                                                    ]+                    UnknownComposite_SDLByParamCompositeLink_SDLDF tpl_id param_id wrng_tpl_id ->+                                thePCSI "E_PCLT_SDLDF_WRNGPRMCMPST" [ ("tpl_id"     , PlainText_PV tpl_id)+                                                                    , ("param_id"   , PlainText_PV param_id)+                                                                    , ("wrng_tpl_id", PlainText_PV wrng_tpl_id)+                                                                    ]+                    SDLReferentialCycle_SDLDF                      tpl_id super_buf ->+                                thePCSI "E_PCLT_SDLDF_REFCYCL"      [ ("tpl_id"     , PlainText_PV tpl_id)+                                                                    , ("super_buf"  , PlainText_PV $ show super_buf)+                                                                    ]+                    ErrornousSDL_SDLDF                             tpl_id esdl ->+                                thePCSI "E_PCLT_SDLDF_ESDL"         [ ("tpl_id"     , PlainText_PV tpl_id)+                                                                    , ("super_buf"  , PCSI_PV $ showAsPCSI esdl)+                                                                    ]++instance HasStaticRawPCLTs SDL_DeterminationFailure where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLT_SDLDF", (M.fromList [("rus",  B.pack "##|E_PCLT_SDLDF_PREFIX##|@@|pclt_sdldf_err_details@@|."), ("eng",  B.pack "##|E_PCLT_SDLDF_PREFIX##|@@|pclt_sdldf_err_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_SDLDF_PREFIX", (M.fromList [("rus", B.pack "Произошла ошибка при определении шаблоном {ИД: \"@@|tpl_id@@|\"} требуемого для отображения уровня детализации: "), ("eng", B.pack "An error occured when trying to determine required by the template {ID: \"@@|tpl_id@@|\"} representation detalization level: ")], str2PCLT_SDL Required_SDLM "##|E_PCLT_SDLDF##|" inner_cfg))+                        , ("E_PCLT_SDLDF_MISSCMPST", (M.fromList [("rus",  B.pack "##|E_PCLT_COMMONS_MISSINGCOMPSTBYRER##|"), ("eng",  B.pack "##|E_PCLT_COMMONS_MISSINGCOMPSTBYRER##|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_SDLDF##|" inner_cfg))+                        , ("E_PCLT_SDLDF_CMPZPARAMREF", (M.fromList [("rus",  B.pack "необходимый уровень детализации для отображения шаблона [ИД: @@|tpl_id@@|], указан быть таким же, как у шаблона, который подставляется под параметр [ИД: @@|param_id@@|]"), ("eng",  B.pack "of template (ID: @@|tpl_id@@|) for message representation required detailization level is referenced to be the same as is one of composite put behind parameter (ID: @@|param_id@@|)")], str2PCLT_SDL Required_SDLM "##|E_PCLT_SDLDF##|" inner_cfg))+                        , ("E_PCLT_SDLDF_MISSPARAM", (M.fromList [("rus",  B.pack "##|E_PCLT_SDLDF_CMPZPARAMREF##|, однако такой параметр вообще отсутствует на входе в реализацию шаблона"), ("eng",  B.pack "##|E_PCLT_SDLDF_CMPZPARAMREF##|, but referenced parameter is missing in realization input")], str2PCLT_SDL Required_SDLM "##|E_PCLT_SDLDF##|" inner_cfg))+                        , ("E_PCLT_SDLDF_WRNGPRMTYP", (M.fromList [("rus",  B.pack "##|E_PCLT_SDLDF_CMPZPARAMREF##|, однако под параметр подставлен не шаблон"), ("eng",  B.pack "##|E_PCLT_SDLDF_CMPZPARAMREF##|, but referenced parameter value is not a template")], str2PCLT_SDL Required_SDLM "##|E_PCLT_SDLDF##|" inner_cfg))+                        , ("E_PCLT_SDLDF_WRNGPRMCMPST", (M.fromList [("rus",  B.pack "##|E_PCLT_SDLDF_CMPZPARAMREF##|, однако под параметр подставлен шаблон [ИД: @@|wrng_tpl_id@@|] - каталогу неизвестный"), ("eng",  B.pack "##|E_PCLT_SDLDF_CMPZPARAMREF##|, but referenced parameter value is set to a template [ID: @@|wrng_tpl_id@@|], which is not in the catalog")], str2PCLT_SDL Required_SDLM "##|E_PCLT_SDLDF##|" inner_cfg))+                        , ("E_PCLT_SDLDF_REFCYCL", (M.fromList [("rus",  B.pack "у данного шаблона для отображения требуемый уровнь детализации такой же, как у указанного - при определении требуемого уровня детализации (остановлен на шаблоне [ИД: @@|tpl_id@@|]) обнаружен цикл таких ссылок. Буфер зацикленных шаблонов: @@|super_buf@@|"), ("eng",  B.pack "for message (of given template) representation required detailization level is referenced to be the same as is defined for the referenced template - in a group of such definitions a referential cycle is detected. Procedure of level requirements determination halted on template [ID: @@|tpl_id@@|]. Cycled tpls buffer: @@|super_buf@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_SDLDF##|" inner_cfg))+                        , ("E_PCLT_SDLDF_ESDL", (M.fromList [("rus",  B.pack "у шаблона [ИД: @@|tpl_id@@|] для отображения требуемый уровнь детализации ошибочен. @@|esdl_reason@@| Вместо определённого используется требование бесконечного уровня"), ("eng",  B.pack "for message (of template [ИД: @@|tpl_id@@|]) representation required detailization level is errornous. @@|esdl_reason@@| The requirement of infinite level is used instead")], str2PCLT_SDL Required_SDLM "##|E_PCLT_SDLDF##|" inner_cfg))+                        ]++--------------------------------------------------------------------++data PCLTRawCatalog__Text_PCLT_MakeMessage = PCLTRawCatalog__Text_PCLT_MakeMessage+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_MakeMessage where+     widenessOfStaticRawPCLTsSet _ = Module_RPSW+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                        [ getStaticRawPCLTs inner_cfg (undefined :: PCSI2Text_Error)+                        , getStaticRawPCLTs inner_cfg (undefined :: SDL_DeterminationFailure)+                        ]-- i wish i knew an easy way how to achieve a smaller code of this by using a "map (getStaticRawPCLTs inner_cfg) [...]" function
+ Text/PCLT/PCSI.hs view
@@ -0,0 +1,100 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | The abbreviation \"PCSI\" means \"Parametric Composable String+-- Instaniation\". Agree, not a very clear name, a more apropriate would be+-- something like that: \"Input Data for Template Representation\", but+-- clear name came to my head when millions (dozens) of ants (variables) were+-- already bearing this name. And I'm a bit lazy to rename everything to sound+-- apropriate, sorry.+module Text.PCLT.PCSI where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.Typeable+import Text.ConstraintedLBS+import Text.PCLT.CommonTypes++-- | By these user fills parameters of templates.+data PCLT_ParamVal =+        PlainText_PV    String+      | PlainTextLBS_PV Lazy.ByteString+      | PCSI_PV         PCSI+   --   Reparsable_PV   PCLT_ParamVal PCSI_ParamsValuesMap -- reserved, currently doesn't work+      -- | Second argument is a separator between 'PCSI's in first argument+      -- Here representation generator automatically adds to each PCSI in+      -- list an implicit parameter @__row_idx@, which holds a value+      -- of current PCSI index in list, starting from 1.+      | PCSIList_PV     [PCSI] PCLT_ParamVal+      | PVList_PV       [PCLT_ParamVal]+      -- | In message generation procedure this stands for a value of+      -- 2nd argument in which every occurence of newline (as is configured in+      -- "Text.PCLT.Config" in config's parameter @pcsNewlineLBS@)+      -- is substituded by @newline ++ (replicate n ' ')@,+      -- where n is the 1st argument+      | Indented_PV     Int PCLT_ParamVal+      -- | In message generation procedure this stands for a value of+      -- @pcsNewlineLBS@ parameter declared in "Text.PCLT.Config".+      -- Different systems means different symbol sequences+      -- under \"newline\"...+      | NewLine_PV+      | Nothing_PV+    deriving (Show, Typeable)+type PCSI_ParamsValuesMap = Map PCLT_ParamKey PCLT_ParamVal++-- | PCSI is an output of our extended Show (to which this package+-- is dedicated). And an input to generate a message using catalog.+data PCSI =+         PCSI {+           pcsiTplID         :: PCLT_ID+         , pcsiParamsValsMap :: PCSI_ParamsValuesMap+         }+    deriving (Show, Typeable)++-- * PCSI constructors++-- | PCSI with an empty set of parameters values.+empPCSI :: PCLT_ID -> PCSI+empPCSI k = PCSI { pcsiTplID = k, pcsiParamsValsMap = M.empty }++thePCSI :: PCLT_ID -> [(PCLT_ParamKey, PCLT_ParamVal)] -> PCSI+thePCSI pcsi_id params_alist =+         PCSI {+           pcsiTplID            = pcsi_id+         , pcsiParamsValsMap = M.fromList params_alist+         }++-- * PCSI maths++addToPCSI :: [PCSI] -> PCSI -> PCSI+addToPCSI l t = foldr+        (\ pcsi2 pcsi1_accum ->+                pcsi1_accum {+                        pcsiParamsValsMap = sumPCSI_PVMs+                                                (pcsiParamsValsMap pcsi1_accum)+                                                (pcsiParamsValsMap pcsi2)+                }+        ) t l++sumPCSI_PVMs :: PCSI_ParamsValuesMap -> PCSI_ParamsValuesMap -> PCSI_ParamsValuesMap+sumPCSI_PVMs pcsi_pvm1 pcsi_pvm2 = M.union pcsi_pvm1 pcsi_pvm2++addPVs2PCSI :: [(PCLT_ParamKey, PCLT_ParamVal)] -> PCSI -> PCSI+addPVs2PCSI pvs pcsi = pcsi { pcsiParamsValsMap = foldr (\ (k, v) accum -> M.insert k v accum) (pcsiParamsValsMap pcsi) pvs}++-- * Standards+-- | It's used in some places of package in errors' representations+-- (in instances of @ShowAsPCSI@ - class declared in "Text.PCLT.ShowAsPCSI").+-- @usualSeparatorInPCSIList = PVList_PV [NewLine_PV, PlainText_PV "|----", NewLine_PV]@+usualSeparatorInPCSIList :: PCLT_ParamVal+usualSeparatorInPCSIList = PVList_PV [NewLine_PV, PlainText_PV "|----", NewLine_PV]
+ Text/PCLT/Parser/AdvancedSepBy.hs view
@@ -0,0 +1,209 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# LANGUAGE BangPatterns #-}++module Text.PCLT.Parser.AdvancedSepBy where++import Control.Monad.State.Strict+import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import Data.MyHelpers+import Data.Int+import Data.List+import qualified Data.Map as M+import Data.Map (Map, (!))+import System.IO.Unsafe+import Text.PCLT.Parser.ParserInternals++-- for cases like "Hi, $$ParamKeyName1$$!\nHow was your day, $$ParamKeyName2$$? ##CompositeName1## ##CompositeName2##"++type SeparationMarkerIdx = Int+data SeparatedSectorMarker =+          Beginning_SSM+        | EOF_SSM+        | InnerMarker_SSM SeparationMarkerIdx+        | Error_SSM StandartMarkingStrategyError -- i know, a bad style to make it dependant of a very specific marking strategy... no time for any better now+       deriving (Eq, Ord)+type MarkedChunkLength = Int64++manyTill_EOForEitherOf :: Parser Char -> [Parser Lazy.ByteString] -> Parser (SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)+manyTill_EOForEitherOf !p !ends_list = Parser $! manyTill_EOForEitherOf' B.empty 0+        where+          alternatives_set = map (\ (end_p, i) -> end_p >> return (InnerMarker_SSM i) ) (zip ends_list [1..])+          ---------------------------+          manyTill_EOForEitherOf' :: Lazy.ByteString -> MarkedChunkLength -> State ParserState (ParserResult (SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength))+          manyTill_EOForEitherOf' !soFar !len = do+                saved <- get+                result <- runParser $ choice alternatives_set+                let returnResult marker = return $ Success (marker, B.pack $ B.unpack $ B.reverse soFar, len) -- any better way to compact many chunks into one?..+                    if_bad = do+                       put saved+                       ps_c <- runParser p+                       case ps_c of+                           Success    c -> manyTill_EOForEitherOf' (B.cons c soFar) (len + 1) -- would use cons' if had time to ensure, that it would keeps tail-recursion+                           IllegalInput -> returnResult $ Error_SSM $ UnallowedCharacter_SMSE (B.head $ pstInput saved)+                           ReachedEOF   -> returnResult     EOF_SSM+                case result of+                    Success a    -> returnResult a+                    IllegalInput -> if_bad+                    ReachedEOF   -> if_bad++type New_Active_Sep_SSM      = SeparatedSectorMarker+type Previous_Active_Sep_SSM = SeparatedSectorMarker+type Current_Sep_SSM         = SeparatedSectorMarker+type Current_Chunk_SSM       = SeparatedSectorMarker+type SectorMarkingStrategy = (Previous_Active_Sep_SSM, Current_Sep_SSM) -> (Current_Chunk_SSM, New_Active_Sep_SSM)++sepBySome :: Parser Char -> SectorMarkingStrategy -> [Parser Lazy.ByteString] -> Parser [(SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)]+sepBySome !p !sectorMarkingStrategy !sep_str_list = _getMarkedChunks1 [] Beginning_SSM+        where+          _getMarkedChunks1 :: [(SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)] -> SeparatedSectorMarker -> Parser [(SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)]+          _getMarkedChunks1 chunks_so_far prev_active_sep_marker =+               do (cur_sep_marker, x, len) <- manyTill_EOForEitherOf p sep_str_list+                  let (cur_chunk_marker, new_active_sep_marker) = sectorMarkingStrategy (prev_active_sep_marker, cur_sep_marker)+                      new_chunks_set = (cur_chunk_marker, x, len) : chunks_so_far+                  case new_active_sep_marker of+                      EOF_SSM -> return $ reverse new_chunks_set+                      _       -> _getMarkedChunks1 new_chunks_set new_active_sep_marker++data StandartMarkingStrategyError =+          InputAfterEOF_SMSE+        | BeginningMNotInTheBeginning_SMSE+        | OverlappingMarkedChunks_SMSE+        | UnsupportedMarkersSequence_SMSE SeparatedSectorMarker SeparatedSectorMarker+        | OpenMarkerAtEOF_SMSE SeparationMarkerIdx+        | UnallowedCharacter_SMSE Char+       deriving (Eq, Ord)++standardMarkingStrategy :: SectorMarkingStrategy+standardMarkingStrategy (prev_active_sep_marker, cur_sep_marker) =+        case (prev_active_sep_marker, cur_sep_marker) of+            (    Beginning_SSM,           EOF_SSM) -> (InnerMarker_SSM 0, EOF_SSM)+            (          EOF_SSM,                 _) -> (Error_SSM InputAfterEOF_SMSE, EOF_SSM)+            (    Beginning_SSM, InnerMarker_SSM i) -> (InnerMarker_SSM 0, InnerMarker_SSM  i)+            (InnerMarker_SSM i,           EOF_SSM) -> case i == 0 of+                                                          True  -> (InnerMarker_SSM 0, EOF_SSM)+                                                          False -> (Error_SSM $ OpenMarkerAtEOF_SMSE i, EOF_SSM)+            (InnerMarker_SSM i,     Beginning_SSM) -> (InnerMarker_SSM i, Error_SSM BeginningMNotInTheBeginning_SMSE)+            (InnerMarker_SSM i, InnerMarker_SSM j) ->+                 case i == j of+                     True  -> (InnerMarker_SSM i, InnerMarker_SSM 0)+                     False -> case i == 0 of+                                  True  -> (InnerMarker_SSM i, InnerMarker_SSM j)+                                  False -> (Error_SSM OverlappingMarkedChunks_SMSE, InnerMarker_SSM j)+            _ -> let err_m = Error_SSM $ UnsupportedMarkersSequence_SMSE prev_active_sep_marker cur_sep_marker+                  in (err_m, err_m)++standardMarkingStrategyFix_StripEmptyChunks :: [(SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)] -> [(SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)]+standardMarkingStrategyFix_StripEmptyChunks = foldr foldr_f []+        where+          foldr_f marked_chunk accum =+                case marked_chunk == (InnerMarker_SSM 0, B.empty, 0) of+                    True  -> accum+                    False -> marked_chunk : accum++type ChunkIndexInList_ = Int+retrieveNonPlainMarkingsMap :: [(SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)] -> M.Map SeparatedSectorMarker [(Lazy.ByteString, ChunkIndexInList_)]+retrieveNonPlainMarkingsMap marked_seq = fst $ foldl foldr_f (M.empty, 0) marked_seq+        where+          foldr_f (accum, ind) marked_chunk =+                case marked_chunk of+                    (InnerMarker_SSM i, str, _) ->+                        case i == 0 of+                            False -> ( M.unionWith+                                                (++)+                                                accum+                                                ( M.singleton (InnerMarker_SSM i) [(str, ind)])+                                     , ind + 1+                                     )+                            True  -> (accum, ind + 1)+                    _ -> (accum, ind + 1)++getListOfMarkings :: M.Map SeparatedSectorMarker [(Lazy.ByteString, ChunkIndexInList_)] -> Int -> [(Lazy.ByteString, ChunkIndexInList_)]+getListOfMarkings m i = case M.lookup (InnerMarker_SSM i) m of+                            Just l  -> l+                            Nothing -> []++retrieveErrorsMarkingsList :: [(SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)] -> [(SeparatedSectorMarker, Lazy.ByteString, ChunkIndexInList_)]+retrieveErrorsMarkingsList marked_seq = fst $ foldl foldr_f ([], 0) marked_seq+        where+          foldr_f (accum, ind) marked_chunk =+                case marked_chunk of+                    (Error_SSM err_msg, str, _) -> ((Error_SSM err_msg, str, ind): accum, ind + 1)+                    _ -> (accum, ind + 1)++{-+-- \n == "\\n"  ==> "\x0d\x0a" or whatever nl is+-- \\ == "\\\\" ==> "\\" = \+translateEscapes :: Lazy.ByteString -> Lazy.ByteString -> (Lazy.ByteString, MarkedChunkLength)+translateEscapes nl s = (B.concat [new_s, B.pack last_state], chars_less)+        where+            nl_len = B.length nl - 2+            (new_s, last_state, chars_less) = B.foldl+                                      (\ (accum, state, cl) ch ->+                                                case state of+                                                    [] -> case ch of+                                                              '\\' -> (           accum, '\\':[], cl)+                                                              _    -> (B.cons' ch accum,      [], cl)+                                                    '\\':[] ->+                                                          case ch of+                                                              '\\' -> (B.cons'  '\\'    accum ,              [], cl + 1)+                                                              'n'  -> (B.concat    [nl, accum],              [], cl + nl_len)+                                      )+                                      (B.empty, [], 0)+                                      s++translateEscapes_inTheListOfMarkings :: Lazy.ByteString -> [(SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)] -> [(SeparatedSectorMarker, Lazy.ByteString, MarkedChunkLength)]+translateEscapes_inTheListOfMarkings nl marked_seq =+        map (\ chu@(m, s, l)->+                        case m of+                            InnerMarker_SSM i -> case i == 0 of+                                                     True  -> let (n_s, l_mod) = translateEscapes nl s in (m, n_s, l - l_mod)+                                                     False -> chu+                            _ -> chu+            )+            marked_seq+-}+------------------------------------------------------------+------------------------------------------------------------++insertInsteadOf_inLBS :: (Lazy.ByteString, Lazy.ByteString) -> Lazy.ByteString -> Lazy.ByteString+insertInsteadOf_inLBS (old_sep, new_sep) lbs =+            case parse (sepBySome anyChar standardMarkingStrategy [stringLBS old_sep]) lbs of+                ( IllegalInput       , _ ) -> error "This should have never happened! Unexpected error in 'insertInsteadOf_inLBS': parse returned unexpected result!"+                ( ReachedEOF         , _ ) -> error "This should have never happened! Unexpected error in 'insertInsteadOf_inLBS': parse returned unexpected result!"+                ( Success chunks_list, _ ) ->+                        B.concat $ intersperse new_sep $ map snd3 chunks_list+------------------------------------------------------------+------------------------------------------------------------++instance Show SeparatedSectorMarker where+        show sms = _prefix ++ _body ++ "."+              where+                _prefix = "Sector separation marker: "+                _body   = case sms of+                              Beginning_SSM -> "input beginning"+                              EOF_SSM       -> "input ending"+                              InnerMarker_SSM sm_idx -> "marker #" ++ show sm_idx+                              Error_SSM smse -> "error '" ++ show smse ++ "'"++instance Show StandartMarkingStrategyError where+        show smse = _prefix ++ _body+           where+              _prefix = "An error occured when parsing a marked text. Marking failed: "+              _body =+                case smse of+                   InputAfterEOF_SMSE -> "input is not allowed after EOF."+                   BeginningMNotInTheBeginning_SMSE -> "beginning is allowed to occur only as the first input marker."+                   OverlappingMarkedChunks_SMSE -> "the marking strategy doesn't allow overlapping marked text chunks."+                   UnsupportedMarkersSequence_SMSE prev_active_sm cur_sm -> "the marking strategy doesn't support markers sequence (active previous separator marker -> current separator marker): " ++ show prev_active_sm ++ " -> " ++ show cur_sm ++ " ."+                   OpenMarkerAtEOF_SMSE sm_idx -> "text ends with unclosed chunk of nonplain (marker index: " ++ show sm_idx ++ ") text."
+ Text/PCLT/Parser/ParserInternals.hs view
@@ -0,0 +1,339 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | Taken from Lucu-0.4 package. The differences from the original:+--+-- (1) this version exports everything,+--+-- (2) added stringLBS,+--+-- (3) - Data.ByteString.Lazy.UTF8.Unified instead or usual lazy+-- ByteString.+-- _________________________+-- Here are the original authors' (PHO) comments:+--+-- Yet another parser combinator. This is mostly a subset of+-- "Text.ParserCombinators.Parsec" but there are some differences:+--+-- * This parser works on 'Data.ByteString.Base.LazyByteString'+--   instead of 'Prelude.String'.+--+-- * Backtracking is the only possible behavior so there is no \"try\"+--   action.+--+-- * On success, the remaining string is returned as well as the+--   parser result.+--+-- * You can choose whether to treat reaching EOF (trying to eat one+--   more letter at the end of string) a fatal error or to treat it a+--   normal failure. If a fatal error occurs, the entire parsing+--   process immediately fails without trying any backtracks. The+--   default behavior is to treat EOF fatal.+--+-- In general, you don't have to use this module directly.++{-# LANGUAGE BangPatterns #-}++module Text.PCLT.Parser.ParserInternals where++import           Control.Monad.State.Strict+import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Foldable as Fold+import           Data.Int+import qualified Data.Sequence as Seq+import           Data.Sequence (Seq, (|>))++-- |@'Parser' a@ is obviously a parser which parses and returns @a@.+newtype Parser a = Parser {+      runParser :: State ParserState (ParserResult a)+    }+++data ParserState+    = PST {+        pstInput      :: Lazy.ByteString+      , pstIsEOFFatal :: !Bool+      }+    deriving (Eq, Show)+++data ParserResult a = Success !a+                    | IllegalInput -- 受理出來ない入力があった+                    | ReachedEOF   -- 限界を越えて讀まうとした+                      deriving (Eq, Show)+++--  (>>=) :: Parser a -> (a -> Parser b) -> Parser b+instance Monad Parser where+    p >>= f = Parser $! do saved <- get -- 失敗した時の爲に状態を保存+                           result <- runParser p+                           case result of+                             Success a    -> runParser (f a)+                             IllegalInput -> do put saved -- 状態を復歸+                                                return IllegalInput+                             ReachedEOF   -> do put saved -- 状態を復歸+                                                return ReachedEOF+    return !x = Parser $! return $! Success x+    fail _    = Parser $! return $! IllegalInput++-- |@'failP'@ is just a synonym for @'Prelude.fail'+-- 'Prelude.undefined'@.+failP :: Parser a+failP = fail undefined++-- |@'parse' p bstr@ parses @bstr@ with @p@ and returns @(# result,+-- remaining #)@.+parse :: Parser a -> Lazy.ByteString -> ( ParserResult a, Lazy.ByteString )+parse !p input -- input は lazy である必要有り。+    = let (!result, state') = runState (runParser p) (PST input True)+      in+        ( result, pstInput state' ) -- pstInput state' も lazy である必要有り。++-- |@'parseStr' p str@ packs @str@ and parses it.+parseStr :: Parser a -> String -> ( ParserResult a, Lazy.ByteString )+parseStr !p input -- input は lazy である必要有り。+    = parse p (B.pack input)+++anyChar :: Parser Char+anyChar = Parser $!+          do state@(PST input _) <- get+             if B.null input then+                 return ReachedEOF+               else+                 do put $! state { pstInput = B.tail input }+                    return (Success $! B.head input)+++eof :: Parser ()+eof = Parser $!+      do PST input _ <- get+         if B.null input then+             return $! Success ()+           else+             return IllegalInput++-- |@'allowEOF' p@ makes @p@ treat reaching EOF a normal failure.+allowEOF :: Parser a -> Parser a+allowEOF !f+    = Parser $! do saved@(PST _ isEOFFatal) <- get+                   put $! saved { pstIsEOFFatal = False }++                   result <- runParser f++                   state <- get+                   put $! state { pstIsEOFFatal = isEOFFatal }++                   return result+++satisfy :: (Char -> Bool) -> Parser Char+satisfy !f+    = do c <- anyChar+         if f c then+             return c+           else+             failP+++char :: Char -> Parser Char+char !c = satisfy (== c)+++string :: String -> Parser String+string !str+    = let bs  = B.pack str+          len = B.length bs+      in+        Parser $!+        do st <- get+           let (bs', rest) = B.splitAt len $ pstInput st+               st'         = st { pstInput = rest }+           if B.length bs' < len then+               return ReachedEOF+             else+               if bs == bs' then+                   do put st'+                      return $ Success str+               else+                   return IllegalInput+++infixr 0 <|>++-- |This is the backtracking alternation. There is no non-backtracking+-- equivalent.+(<|>) :: Parser a -> Parser a -> Parser a+(!f) <|> (!g)+    = Parser $! do saved  <- get -- 状態を保存+                   result <- runParser f+                   case result of+                     Success a    -> return $! Success a+                     IllegalInput -> do put saved -- 状態を復歸+                                        runParser g+                     ReachedEOF   -> if pstIsEOFFatal saved then+                                         do put saved+                                            return ReachedEOF+                                     else+                                         do put saved+                                            runParser g+++choice :: [Parser a] -> Parser a+choice = foldl (<|>) failP+++oneOf :: [Char] -> Parser Char+oneOf = foldl (<|>) failP . map char+++notFollowedBy :: Parser a -> Parser ()+notFollowedBy !p+    = Parser $! do saved  <- get -- 状態を保存+                   result <- runParser p+                   case result of+                     Success _    -> do put saved -- 状態を復歸+                                        return IllegalInput+                     IllegalInput -> do put saved -- 状態を復歸+                                        return $! Success ()+                     ReachedEOF   -> do put saved -- 状態を復歸+                                        return $! Success ()+++digit :: Parser Char+digit = do c <- anyChar+           if c >= '0' && c <= '9' then+               return c+             else+               failP+++hexDigit :: Parser Char+hexDigit = do c <- anyChar+              if (c >= '0' && c <= '9') ||+                 (c >= 'a' && c <= 'f') ||+                 (c >= 'A' && c <= 'F') then+                  return c+                else+                  failP+++many :: forall a. Parser a -> Parser [a]+many !p = Parser $!+          do state <- get+             let ( result, state' ) = many' state Seq.empty+             put state'+             return result+    where+      many' :: ParserState -> Seq a -> ( ParserResult [a], ParserState )+      many' !st !soFar+          = case runState (runParser p) st of+              (Success a,  st') -> many' st' (soFar |> a)+              (IllegalInput, _) -> ( Success (Fold.toList soFar), st )+              (ReachedEOF  , _) -> if pstIsEOFFatal st then+                                       ( ReachedEOF, st )+                                   else+                                       ( Success (Fold.toList soFar), st )++manyChar :: Parser Char -> Parser Lazy.ByteString+manyChar !p = Parser $!+              do state <- get+                 case scan' state 0 of+                   Success len+                       -> do let (bs, rest) = B.splitAt len (pstInput state)+                                 state'     = state { pstInput = rest }+                             put state'+                             return $ Success bs+                   ReachedEOF+                       -> if pstIsEOFFatal state then+                              return ReachedEOF+                          else+                              error "internal error"+                   _   -> error "internal error"+    where+      scan' :: ParserState -> Int64 -> ParserResult Int64+      scan' !st !soFar+          = case runState (runParser p) st of+              (Success _   , st') -> scan' st' (soFar + 1)+              (IllegalInput, _  ) -> Success soFar+              (ReachedEOF  , _  ) -> if pstIsEOFFatal st then+                                         ReachedEOF+                                     else+                                         Success soFar+++many1 :: Parser a -> Parser [a]+many1 !p = do x  <- p+              xs <- many p+              return (x:xs)+++count :: Int -> Parser a -> Parser [a]+count !n !p = Parser $! count' n p Seq.empty++-- This implementation is rather ugly but we need to make it+-- tail-recursive to avoid stack overflow.+count' :: Int -> Parser a -> Seq a -> State ParserState (ParserResult [a])+count' 0  _  !soFar = return $! Success $! Fold.toList soFar+count' !n !p !soFar = do saved  <- get+                         result <- runParser p+                         case result of+                           Success a    -> count' (n-1) p (soFar |> a)+                           IllegalInput -> do put saved+                                              return IllegalInput+                           ReachedEOF   -> do put saved+                                              return ReachedEOF+++-- def may be a _|_+option :: a -> Parser a -> Parser a+option def !p = p <|> return def+++sepBy :: Parser a -> Parser sep -> Parser [a]+sepBy !p !sep = sepBy1 p sep <|> return []+++sepBy1 :: Parser a -> Parser sep -> Parser [a]+sepBy1 !p !sep+    = do x  <- p+         xs <- many $! sep >> p+         return (x:xs)+++sp :: Parser Char+sp = char ' '+++ht :: Parser Char+ht = char '\t'+++crlf :: Parser String+crlf = string "\x0d\x0a"++stringLBS :: Lazy.ByteString -> Parser Lazy.ByteString+stringLBS !bs+    = let len = B.length bs+      in+        Parser $!+        do st <- get+           let (bs', rest) = B.splitAt len $ pstInput st+               st'         = st { pstInput = rest }+           case B.length bs' < len of+               True -> return ReachedEOF+               False ->+                   case bs == bs' of+                       True -> do+                           put st'+                           return $ Success bs+                       False -> return IllegalInput
+ Text/PCLT/SDL.hs view
@@ -0,0 +1,100 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | Simply saying: with SDL we regulate, how much some Reader (of our+-- generated messages) wishes (is allowed) to see.+--+-- \"SDL\" is an abbreviation for \"Show Detalization Level\".+-- Perhaps it better sound \"Representation Detalization Level\", but it+-- was too late to change term - too many variables has names @sdl@,+-- and author is too lazy to change them on @rdl@s.+-- However, \"Representation Detalization Level\" version is sometimes used -+-- it is to be understood as synonym to SDL.+-- Term \"Detailizable content (message)\" in this package has a following+-- meaning: some content, representing which it is possible to regulate,+-- in how much of details it is to be represented.+module Text.PCLT.SDL where++import Data.MyHelpers+import Data.Typeable++---------------------------------------------------------------------------------+---------------------------------------------------------------------------------+---------------------------------------------------------------------------------++-- | @Zero_SDL < One_SDL < SDL Int < InfinitelyBig_SDL@+data ShowDetalizationLevel =+        Zero_SDL+      | One_SDL+      | SDL Int+      | InfinitelyBig_SDL+     deriving (Typeable)++-- | SDL may be seen in two different moduses:+--+-- * as a requirement for representation by a localizable template:+-- \"SDL of repesentation reciever must be equal or bigger then that,+-- orelse message from this template won't be generated\"+--+-- * as an allocateion to a repesentation reciever.+data SDLModus = Allocated_SDLM | Required_SDLM deriving (Eq, Show, Typeable)++-- | In case, if SDL (of reciever of template requirement) is unclear,+-- and if it is allowed by config - then SDL gets assigned according to margin:+--+-- * if modus is allocation to reciever - the we give him @Zero_SDL@ (minimum)+--+-- * if modus is requirement by template - the we give+-- him @InfinitelyBig_SDL@ (maximum)+marginOfSDLModus :: SDLModus -> ShowDetalizationLevel+marginOfSDLModus sdlm =+            case sdlm of+                Required_SDLM  -> InfinitelyBig_SDL+                Allocated_SDLM -> Zero_SDL++strict_str2sdl :: String -> Maybe ShowDetalizationLevel+strict_str2sdl x =+                if x == "+inf" then Just InfinitelyBig_SDL+           else if x == "one"    then Just One_SDL+           else if x == "zero"   then Just Zero_SDL+           else case str2Numeric x of+                    Just  n -> Just $ SDL n+                    Nothing -> Nothing++instance Show ShowDetalizationLevel where+        show InfinitelyBig_SDL = "+inf"+        show Zero_SDL          = "zero"+        show One_SDL           = "one"+        show (SDL i)           = show i++instance Eq ShowDetalizationLevel where+        sdl1 == sdl2 =+                case (sdl1, sdl2) of+                    (InfinitelyBig_SDL, InfinitelyBig_SDL) -> True+                    (Zero_SDL         , Zero_SDL         ) -> True+                    (One_SDL          , One_SDL          ) -> True+                    (SDL i1           , SDL i2           ) -> i1 == i2+                    _ -> False++instance Ord ShowDetalizationLevel where+        sdl1 `compare` sdl2 =+                case (sdl1, sdl2) of+                    (InfinitelyBig_SDL, InfinitelyBig_SDL) -> EQ+                    (_                , InfinitelyBig_SDL) -> LT+                    (InfinitelyBig_SDL, _                ) -> GT+                    (Zero_SDL         , Zero_SDL         ) -> EQ+                    (Zero_SDL         , _                ) -> LT+                    (_                , Zero_SDL         ) -> GT+                    (One_SDL          , One_SDL          ) -> EQ+                    (One_SDL          , _                ) -> LT+                    (_                , One_SDL          ) -> GT+                    (SDL            i1, SDL i2           ) -> i1 `compare` i2+
+ Text/PCLT/SDL__.hs view
@@ -0,0 +1,86 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# OPTIONS_HADDOCK hide #-}++module Text.PCLT.SDL__ where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Text.PCLT.SH__+import Text.PCLT.SDL++-------------------------------------------++data ShowDetalizationLevel_PCSIWrapper = ShowDetalizationLevel_PCSIWrapper ShowDetalizationLevel+instance ShowAsPCSI ShowDetalizationLevel_PCSIWrapper where+        showAsPCSI (ShowDetalizationLevel_PCSIWrapper sdl) = thePCSI "PCLT_SDL" [("pclt_sdl_details", PCSI_PV $ showAsPCSI sdl)]++instance ShowAsPCSI ShowDetalizationLevel where+        showAsPCSI sdl =+             let pcsi_id_suffix = case sdl of+                                     InfinitelyBig_SDL -> "INFBIG"+                                     Zero_SDL          -> "ZERO"+                                     One_SDL           -> "ONE"+                                     (SDL _)           -> "NUM"+              in thePCSI+                        ("PCLT_SDL_" ++ pcsi_id_suffix)+                        [("sdl_m", PlainText_PV $ show sdl)]++instance HasStaticRawPCLTs ShowDetalizationLevel where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("PCLT_SDL", (M.fromList [("rus", B.pack "##|PCLT_SDL_PREFIX##|@@|pclt_sdl_details@@|."), ("eng", B.pack "##|PCLT_SDL_PREFIX##|@@|pclt_sdl_details@@|.")], str2PCLT_SDL Required_SDLM "5000" inner_cfg))+                        , ("PCLT_SDL_PREFIX", (M.fromList [("rus", B.pack "Уровень детализации отображения сообщения из шаблона: "), ("eng", B.pack "Show detalization level from a message template:")], str2PCLT_SDL Required_SDLM "##|PCLT_SDL##|" inner_cfg))+                        , ("PCLT_SDL_INFBIG", (M.fromList [("rus", B.pack "бесконечно большой (\"@@|sdl_m@@|\")"), ("eng", B.pack "infinitely big (\"@@|sdl_m@@|\")")], str2PCLT_SDL Required_SDLM "##|PCLT_SDL##|" inner_cfg))+                        , ("PCLT_SDL_ZERO", (M.fromList [("rus", B.pack "ноль (\"@@|sdl_m@@|\")"), ("eng", B.pack "zero (\"@@|sdl_m@@|\")")], str2PCLT_SDL Required_SDLM "##|PCLT_SDL##|" inner_cfg))+                        , ("PCLT_SDL_ONE", (M.fromList [("rus", B.pack "единица (\"@@|sdl_m@@|\")"), ("eng", B.pack "one (\"@@|sdl_m@@|\")")], str2PCLT_SDL Required_SDLM "##|PCLT_SDL##|" inner_cfg))+                        , ("PCLT_SDL_NUM", (M.fromList [("rus", B.pack "номер: \"@@|sdl_m@@|\""), ("eng", B.pack "numeric: \"@@|sdl_m@@|\"")], str2PCLT_SDL Required_SDLM "##|PCLT_SDL##|" inner_cfg))+                        ]++------------------------------------------------------------------------------++data SDLModus_PCSIWrapper = SDLModus_PCSIWrapper SDLModus+instance ShowAsPCSI SDLModus_PCSIWrapper where+        showAsPCSI (SDLModus_PCSIWrapper sdlm) = thePCSI "PCLT_SDLM" [("pclt_sdlm_details", PCSI_PV $ showAsPCSI sdlm)]++instance ShowAsPCSI SDLModus where+        showAsPCSI sdlm =+             let pcsi_id_suffix = case sdlm of+                                     Allocated_SDLM -> "ALLOC"+                                     Required_SDLM          -> "REQ"+              in thePCSI+                        ("PCLT_SDLM_" ++ pcsi_id_suffix)+                        []++instance HasStaticRawPCLTs SDLModus where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("PCLT_SDLM", (M.fromList [("rus", B.pack "##|PCLT_SDLM_PREFIX##|@@|pclt_sdlm_details@@|."), ("eng", B.pack "##|PCLT_SDLM_PREFIX##|@@|pclt_sdlm_details@@|.")], str2PCLT_SDL Required_SDLM "##|PCLT_SDL##|" inner_cfg))+                        , ("PCLT_SDLM_PREFIX", (M.fromList [("rus", B.pack "Контекст уровня детализации отображения сообщения: "), ("eng", B.pack "Show detalization level usage:")], str2PCLT_SDL Required_SDLM "##|PCLT_SDLM##|" inner_cfg))+                        , ("PCLT_SDLM_ALLOC", (M.fromList [("rus", B.pack "дозволенный получателю сообщения"), ("eng", B.pack "allowed to message reader")], str2PCLT_SDL Required_SDLM "##|PCLT_SDLM##|" inner_cfg))+                        , ("PCLT_SDLM_REQ", (M.fromList [("rus", B.pack "требуемый для отоброжения"), ("eng", B.pack "required for message representation")], str2PCLT_SDL Required_SDLM "##|PCLT_SDLM##|" inner_cfg))+                        ]++------------------------------------------------------------------------------++data PCLTRawCatalog__Text_PCLT_SDL = PCLTRawCatalog__Text_PCLT_SDL+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_SDL where+     widenessOfStaticRawPCLTsSet _ = Module_RPSW+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                        [ getStaticRawPCLTs inner_cfg (undefined :: ShowDetalizationLevel)+                        , getStaticRawPCLTs inner_cfg (undefined :: SDLModus)+                        ] -- i wish i knew an easy way how to achieve a smaller code of this by using a "map (getStaticRawPCLTs inner_cfg) [...]" function
+ Text/PCLT/SH__.hs view
@@ -0,0 +1,28 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | This is a usual set for modules, that are to be imported by modules+-- dedicated to declaring 'ShowAsPCSI' and 'HasStaticRawPCLTs' instances+module Text.PCLT.SH__ (+             module Text.PCLT.CatalogMaths+           , module Text.PCLT.HasStaticRawPCLTs+           , module Text.PCLT.ShowAsPCSI+           , module Text.PCLT.PCSI+           , module Text.PCLT.Template+           , module Text.PCLT.SDL+           ) where++import Text.PCLT.CatalogMaths+import Text.PCLT.HasStaticRawPCLTs+import Text.PCLT.ShowAsPCSI+import Text.PCLT.PCSI+import Text.PCLT.Template+import Text.PCLT.SDL
+ Text/PCLT/ShowAsPCSI.hs view
@@ -0,0 +1,24 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | WARNING: Creating an instance of 'ShowAsPCSI' for 'String', @ByteString@s+-- and/or other text types is not recommended. Use of such instaniations+-- would dread strictness of templates catalog structure - make it's+-- use workaroundish, less systematic and less strict, which is a way+-- to badmade applications.+module Text.PCLT.ShowAsPCSI where++import Text.PCLT.PCSI+import Text.PCLT.Parser.AdvancedSepBy++-- | Our extended version of @Show@ class+class ShowAsPCSI t where+     showAsPCSI :: t -> PCSI
+ Text/PCLT/ShowAsPCSI__.hs view
@@ -0,0 +1,136 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# OPTIONS_HADDOCK hide #-}++module Text.PCLT.ShowAsPCSI__ where++import Control.Exception+import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Text.PCLT.SH__+import Text.PCLT.Parser.AdvancedSepBy++-----------------------------------------------------------------------+-------STANDARD-INSTANCES----------------------------------------------+-----------------------------------------------------------------------++-- WARNING: Creating an instance of ShowAsPCSI for String, LBS and/or other text types is not recommended.+--          Use of such instaniations would dread strictness of templates catalog structure - make it's use workaroundish, less systematic and less strict, which is a way to badmade applications.++instance ShowAsPCSI SomeException where+        showAsPCSI e = thePCSI "LLEXCPT" [("excpt_msg", PlainText_PV $ show e)]++instance ShowAsPCSI Bool where+        showAsPCSI b =+                case b of+                    True  -> thePCSI "TRUE"  []+                    False -> thePCSI "FALSE" []++instance ShowAsPCSI a => ShowAsPCSI (Maybe a) where+        showAsPCSI mb_a = thePCSI "MAYBE_A" [("maybe_cnstr", PCSI_PV maybe_cnstr_pcsi)]+             where+                maybe_cnstr_pcsi = case mb_a of+                                       Nothing -> empPCSI "MAYBE_NOTHING"+                                       Just  a -> thePCSI "MAYBE_JUST" [("a", PCSI_PV $ showAsPCSI a)]++-----------------------------------------------------------------------+-------STANDARD-INSTANCES-[END]----------------------------------------+-----------------------------------------------------------------------++instance ShowAsPCSI SeparatedSectorMarker where+        showAsPCSI sms = case sms of+                             Beginning_SSM          -> empPCSI "PARSER_SSM_BEGIN"+                             EOF_SSM                -> empPCSI "PARSER_SSM_EOF"+                             InnerMarker_SSM sm_idx -> thePCSI "PARSER_SSM_INNER" [("sm_idx", PlainText_PV $ show sm_idx)]+                             Error_SSM         smse -> thePCSI "PARSER_SSM_ERR"   [("smse"  , PCSI_PV $ showAsPCSI smse)]++data SeparatedSectorMarker_PCSIWrapped = SeparatedSectorMarker_PCSIWrapped SeparatedSectorMarker+instance ShowAsPCSI SeparatedSectorMarker_PCSIWrapped where+        showAsPCSI (SeparatedSectorMarker_PCSIWrapped sms) = thePCSI "PARSER_SSM" [("parser_ssm_details", PCSI_PV $ showAsPCSI sms)]++instance HasStaticRawPCLTs SeparatedSectorMarker where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("PARSER_SSM", (M.fromList [("rus", B.pack "##|PARSER_SSM_PREFIX##|@@|parser_ssm_details@@|."), ("eng", B.pack "##|PARSER_SSM_PREFIX##|@@|parser_ssm_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("PARSER_SSM_PREFIX", (M.fromList [("rus", B.pack "Маркер разделения секторов:"), ("eng", B.pack "Sector separation marker: ")], str2PCLT_SDL Required_SDLM "##|PARSER_SSM##|" inner_cfg))+                        , ("PARSER_SSM_BEGIN", (M.fromList [("rus", B.pack "начало ввода"), ("eng", B.pack "input beginning")], str2PCLT_SDL Required_SDLM "##|PARSER_SSM##|" inner_cfg))+                        , ("PARSER_SSM_EOF", (M.fromList [("rus", B.pack "конец ввода"), ("eng", B.pack "input ending")], str2PCLT_SDL Required_SDLM "##|PARSER_SSM##|" inner_cfg))+                        , ("PARSER_SSM_INNER", (M.fromList [("rus", B.pack "маркер #@@|sm_idx@@|"), ("eng", B.pack "marker #@@|sm_idx@@|")], str2PCLT_SDL Required_SDLM "##|PARSER_SSM##|" inner_cfg))+                        , ("PARSER_SSM_ERR", (M.fromList [("rus", B.pack "ошибка \"@@|smse@@|\""), ("eng", B.pack "error \"@@|smse@@|\"")], str2PCLT_SDL Required_SDLM "##|PARSER_SSM##|" inner_cfg))+                        ]++------------------------------------------------------------------------------++instance ShowAsPCSI StandartMarkingStrategyError where+        showAsPCSI smse = case smse of+                           InputAfterEOF_SMSE               -> empPCSI "E_PARSER_SMSE_INPUTAFTEREOF"+                           BeginningMNotInTheBeginning_SMSE -> empPCSI "E_PARSER_SMSE_BEGINNIGINMID"+                           OverlappingMarkedChunks_SMSE     -> empPCSI "E_PARSER_SMSE_OVERLAPMARK"+                           UnsupportedMarkersSequence_SMSE prev_active_sm cur_sm+                                                            -> thePCSI "E_PARSER_SMSE_UNSUPMARKSEQ"+                                                                           [ ("prev_active_sm", PCSI_PV $ showAsPCSI prev_active_sm)+                                                                           , ("cur_sm"        , PCSI_PV $ showAsPCSI cur_sm)+                                                                           ]+                           OpenMarkerAtEOF_SMSE      sm_idx -> thePCSI "E_PARSER_SMSE_UNFINWHENEOF"+                                                                           [("sm_idx"         , PlainText_PV $ show sm_idx)]+                           UnallowedCharacter_SMSE        c -> thePCSI "E_PARSER_SMSE_BADCHAR"+                                                                           [("c"              , PlainText_PV $ show c)]+data StandartMarkingStrategyError_PCSIWrapped = StandartMarkingStrategyError_PCSIWrapped StandartMarkingStrategyError+instance ShowAsPCSI StandartMarkingStrategyError_PCSIWrapped where+        showAsPCSI (StandartMarkingStrategyError_PCSIWrapped smse) = thePCSI "E_PARSER_SMSE" [("parser_smse_err_details", PCSI_PV $ showAsPCSI smse)]++instance HasStaticRawPCLTs StandartMarkingStrategyError where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PARSER_SMSE", (M.fromList [("rus", B.pack "##|E_PARSER_SMSE_PREFIX##|@@|parser_smse_err_details@@|."), ("eng", B.pack "##|E_PARSER_SMSE_PREFIX##|@@|parser_smse_err_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PARSER_SMSE_PREFIX", (M.fromList [("rus", B.pack "Произошла ошибка при грамматическом разборе маркированого текста. Ошибка маркирования:"), ("eng", B.pack "An error occured when parsing a marked text. Marking failed: ")], str2PCLT_SDL Required_SDLM "##|E_PARSER_SMSE##|" inner_cfg))+                        , ("E_PARSER_SMSE_INPUTAFTEREOF", (M.fromList [("rus", B.pack "ввод после конца ввода"), ("eng", B.pack "input is not allowed after EOF")], str2PCLT_SDL Required_SDLM "##|E_PARSER_SMSE##|" inner_cfg))+                        , ("E_PARSER_SMSE_BEGINNIGINMID", (M.fromList [("rus", B.pack "начало вводе не в начале"), ("eng", B.pack "beginning is allowed to occur only as the first input marker")], str2PCLT_SDL Required_SDLM "##|E_PARSER_SMSE##|" inner_cfg))+                        , ("E_PARSER_SMSE_OVERLAPMARK", (M.fromList [("rus", B.pack "пересекающиеся маркированые регионы не допускаются"), ("eng", B.pack "the marking strategy doesn't allow overlapping marked text chunks")], str2PCLT_SDL Required_SDLM "##|E_PARSER_SMSE##|" inner_cfg))+                        , ("E_PARSER_SMSE_UNSUPMARKSEQ", (M.fromList [("rus", B.pack "неподдерживаемая последовательность маркеров (активный предыдущий маркер -> текущий маркер): @@|prev_active_sm@@| -> @@|cur_sm@@|"), ("eng", B.pack "the marking strategy doesn't support markers sequence (active previous separator marker -> current separator marker): @@|prev_active_sm@@| -> @@|cur_sm@@|")], str2PCLT_SDL Required_SDLM "##|E_PARSER_SMSE##|" inner_cfg))+                        , ("E_PARSER_SMSE_UNFINWHENEOF", (M.fromList [("rus", B.pack "ввод оканчивается незакрытым маркированым регионом (индекс маркера: @@|sm_idx@@|)"), ("eng", B.pack "input ends with unclosed chunk of text (marker index: @@|sm_idx@@|)")], str2PCLT_SDL Required_SDLM "##|E_PARSER_SMSE##|" inner_cfg))+                        , ("E_PARSER_SMSE_BADCHAR", (M.fromList [("rus", B.pack "поток символов застопорился из-за недопустимого символа"), ("eng", B.pack "input flow stopped due to occurrence of unallowed character")], str2PCLT_SDL Required_SDLM "##|E_PARSER_SMSE##|" inner_cfg))+                        ]++------------------------------------------------------------------------------++data PCLTRawCatalog__Text_PCLT_ShowAsPCSI_GeneralCommons = PCLTRawCatalog__Text_PCLT_ShowAsPCSI_GeneralCommons+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_ShowAsPCSI_GeneralCommons where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+             PCLT_RawCatalogData $ M.fromList+                                        [+                                          ("TRUE", (M.fromList [("rus",  B.pack "ДА"), ("eng",  B.pack "TRUE")], str2PCLT_SDL Required_SDLM "one" inner_cfg))+                                        , ("FALSE", (M.fromList [("rus",  B.pack "НЕТ"), ("eng",  B.pack "FALSE")], str2PCLT_SDL Required_SDLM "##|TRUE##|" inner_cfg))++                                        , ("MAYBE_A", (M.fromList [("rus",  B.pack "@@|maybe_cnstr@@|"), ("eng",  B.pack "@@|maybe_cnstr@@|")], str2PCLT_SDL Required_SDLM "##|TRUE##|" inner_cfg))+                                        , ("MAYBE_JUST", (M.fromList [("rus",  B.pack "@@|a@@|"), ("eng",  B.pack "@@|a@@|")], str2PCLT_SDL Required_SDLM "##|MAYBE_A##|" inner_cfg))+                                        , ("MAYBE_NOTHING", (M.fromList [("rus", B.pack "ничего"), ("eng", B.pack "nothing")], str2PCLT_SDL Required_SDLM "##|MAYBE_A##|" inner_cfg))++                                        , ("LLEXCPT", (M.fromList [("rus", B.pack "Программное исключение, детали: \"@@|excpt_msg@@|\""), ("eng", B.pack "Program exception, details: \"@@|excpt_msg@@|\"")], str2PCLT_SDL Required_SDLM "1000" inner_cfg))+                                        ]++------------------------------------------------------------------------------+++data PCLTRawCatalog__Text_PCLT_ShowAsPCSI = PCLTRawCatalog__Text_PCLT_ShowAsPCSI+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_ShowAsPCSI where+     widenessOfStaticRawPCLTsSet _ = Module_RPSW+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                        [ getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_ShowAsPCSI_GeneralCommons)+                        , getStaticRawPCLTs inner_cfg (undefined :: SeparatedSectorMarker)+                        , getStaticRawPCLTs inner_cfg (undefined :: StandartMarkingStrategyError)+                        ] -- i wish i knew an easy way how to achieve a smaller code of this by using a "map (getStaticRawPCLTs inner_cfg) [...]" function
+ Text/PCLT/Template.hs view
@@ -0,0 +1,280 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- | Here are declared 'LocalizableTemplate' (also called PCLT)+-- and 'LocalizedTemplate'.+-- Here by localization is meant localization in languages.+-- First (localizable template) is above languages,+-- while second (localized template) is a template version+-- in a concrete language.+module Text.PCLT.Template where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import Data.List+import qualified Data.Map as M+import Data.Map (Map, (!))+import Data.MyHelpers+import Data.Typeable+import Text.PCLT.Parser.AdvancedSepBy+import Text.PCLT.Parser.ParserInternals+import Text.PCLT.CommonTypes+import Text.PCLT.Config+import Text.PCLT.SDL++-- * Template pieces++-- | These are types of template pieces. They are made by 'ssm2ldtm'+-- from 'Text.PCLT.Parser.AdvancedSepBy.SeparatedSectorMarker'+data PCS_SpecificMarkings =+         PlainText_LngTplM+       | Parameter_LngTplM+       | Composite_LngTplM+       | Unsupported_LngTplM SeparatedSectorMarker+     deriving (Eq, Show, Typeable)++ssm2ldtm :: SeparatedSectorMarker -> PCS_SpecificMarkings+ssm2ldtm ssm =+           case ssm of+               Error_SSM err_msg -> Unsupported_LngTplM ssm+               InnerMarker_SSM i ->+                             if i == 0 then PlainText_LngTplM+                        else if i == 1 then Parameter_LngTplM+                        else if i == 2 then Composite_LngTplM+                        else                Unsupported_LngTplM ssm+               _ -> Unsupported_LngTplM ssm++-- | Template content.+type LngTpl_AbstractedString  = [(PCS_SpecificMarkings, Lazy.ByteString, MarkedChunkLength)]++-- | Extract a list of parameter names from a template content.+listOfParams :: LngTpl_AbstractedString -> [ParamName_LBS]+listOfParams str_struct = foldl (\ accum (marker, str, _) -> case marker == Parameter_LngTplM of {True -> str : accum; False -> accum }) [] str_struct++------------------------------------------------------------------------++-- * Parsing from a lazy ByteString to a localized template content++type ParserBadResult = String+-- | These errors are possible only if program is wrong.+data PCLT_ParserLowLevelFailure =+          UnexpectedParserResult_PLLF_PCLT ParserBadResult+        | BadMarker_PLLF_PCLT SeparatedSectorMarker Lazy.ByteString ChunkIndexInList_+     deriving (Show, Typeable)++-- | The parsing uses parameters+-- 'Test.PCLT.Config.pcsParameterPlaceholderWrapper' and+-- 'Test.PCLT.Config.pcsCompositePlaceholderWrapper' of+-- 'Test.PCLT.Config.PCLT_InnerConfig'.+-- The list @[PCLT_CompositeKey]@ in the result is a list of composite keys+-- (template IDs, used by template as inclusions)+doTheParse :: PCLT_InnerConfig+           -> Lazy.ByteString+           -> ( [PCLT_ParserLowLevelFailure], Maybe ( LngTpl_AbstractedString, [PCLT_CompositeKey] ))+doTheParse pcsc_config str =+    let parser = sepBySome+                        anyChar+                        standardMarkingStrategy+                        [ stringLBS $ pcsParameterPlaceholderWrapper pcsc_config+                        , stringLBS $ pcsCompositePlaceholderWrapper pcsc_config+                        ]+     in case parse parser str of+            ( IllegalInput               , _ ) -> ([UnexpectedParserResult_PLLF_PCLT "IllegalInput"], Nothing)+            ( ReachedEOF                 , _ ) -> ([UnexpectedParserResult_PLLF_PCLT "ReachedEOF"]  , Nothing)+            ( Success  marked_chunks_list, _ ) ->+                let _fixed_marked_chunks_list = standardMarkingStrategyFix_StripEmptyChunks marked_chunks_list+                    list_of_parser_errors     = map (\ (ssm, s, idx) -> BadMarker_PLLF_PCLT ssm s idx) $ retrieveErrorsMarkingsList _fixed_marked_chunks_list+                    non_plain_markings_map    = retrieveNonPlainMarkingsMap _fixed_marked_chunks_list+                    fixed_marked_chunks_list  = map (\ (ssm, str, len) -> (ssm2ldtm ssm, str, len)) _fixed_marked_chunks_list+                    list_of_composites_keys   = map B.unpack $ fst $ unzip $ getListOfMarkings non_plain_markings_map 2+                 in (list_of_parser_errors, Just (fixed_marked_chunks_list, list_of_composites_keys))++------------------------------------------------------------------------++-- * Localized template++type PCLT_CatalogMap          = Map PCLT_ID LocalizableTemplate+type LngTpl_SubCompositesMap  = PCLT_CatalogMap++data LocalizedTemplate =+        LocalizedTemplate {+                  ldtAbstractedString  :: LngTpl_AbstractedString+                -- | Each composition tree is kept together with each+                -- localization. This is done for speedup and is a source+                -- of complexities, when forming a catalog and sustaining it's+                -- data consistency. So it comes to this:+                -- templates are purely-referenced by+                --+                -- * catalog ('PCLT_CatalogMap') and+                --+                -- * templates, that uses them as composites+                -- ('LngTpl_SubCompositesMap').+                --+                -- By \"purely-reference\" here is meant, that templates are+                -- formed only once, they have one instace in memory, but+                -- are referenced twice - from composeds and from catalog map+                , ldtSubcompositesMap  :: LngTpl_SubCompositesMap+        }+     deriving (Show, Typeable)++-- * Text.PCLT.Config.pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets++type DefaultLngTpl    = LocalizedTemplate+type NondefaultLngTpl = LocalizedTemplate+-- | Carrying strict orientation routines. See description of+-- 'Text.PCLT.Config.StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets'.+compareStrictOrientationOnDefault :: PCLT_ID -> StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets -> NondefaultLngTpl -> DefaultLngTpl -> Bool+compareStrictOrientationOnDefault tpl_id so nondflt_ldt dflt_ldt =+        let (   dflt_subcomps    ,    dflt_params    ) = (fst . unzip . M.toList . ldtSubcompositesMap, listOfParams . ldtAbstractedString) `apFrom2ple` dflt_ldt+            (nondflt_subcomps    , nondflt_params    ) = (fst . unzip . M.toList . ldtSubcompositesMap, listOfParams . ldtAbstractedString) `apFrom2ple` nondflt_ldt+         in _compareStrictOrientationOnDefault tpl_id so (nondflt_subcomps, nondflt_params) (dflt_subcomps, dflt_params)++_compareStrictOrientationOnDefault :: PCLT_ID -> StrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets -> ([PCLT_ID], [ParamName_LBS]) -> ([PCLT_ID], [ParamName_LBS]) -> Bool+_compareStrictOrientationOnDefault tpl_id so (nondflt_subcomps, nondflt_params) (dflt_subcomps, dflt_params) =+        let memb  = elem tpl_id $ soExcludingInComposites so+            crit1 =        soStrict_IsIt so  && (not memb)+            crit2 = (not $ soStrict_IsIt so) &&      memb+            crit  = crit1 || crit2+            local_c_exclusions = soExcludingComposites so ++ (snd $ unzip $ filter+                                                                                (\ (_tpl_id, _) -> _tpl_id == tpl_id)+                                                                                (soExcludingCompComposites so)+                                                             )+            local_p_exclusions =+                              map+                                B.pack+                                ( soExcludingParameters so ++ (snd $ unzip $ filter+                                                                                (\ (_tpl_id, _) -> _tpl_id == tpl_id)+                                                                                (soExcludingCompParameters so)+                                )                             )++            op :: Eq a => [a] -> [a] -> [a]+            op = case crit of+                     True  -> (\\)+                     False -> intersect+            (   so_dflt_subcomps    ,    so_dflt_params    ) = (    dflt_subcomps `op`     local_c_exclusions,    dflt_params `op` local_p_exclusions)+            (so_nondflt_subcomps    , so_nondflt_params    ) = ( nondflt_subcomps `op`     local_c_exclusions, nondflt_params `op` local_p_exclusions)+            (  so_union_subcomps    ,   so_union_params    ) = ( so_dflt_subcomps `union` so_nondflt_subcomps, so_dflt_params `union` so_nondflt_params)+            (so_nondflt_subcomps_len, so_nondflt_params_len) = (length so_nondflt_subcomps, length so_nondflt_params)+            (   so_dflt_subcomps_len,    so_dflt_params_len) = (length    so_dflt_subcomps, length    so_dflt_params)+            (  so_union_subcomps_len,   so_union_params_len) = (length   so_union_subcomps, length   so_union_params)++         in    so_union_subcomps_len ==    so_dflt_subcomps_len && so_union_params_len ==    so_dflt_params_len+            && so_union_subcomps_len == so_nondflt_subcomps_len && so_union_params_len == so_nondflt_params_len++------------------------------------------------------------------------+-- * Requirement for making a representation from template - SDL++-- | This is an extending wrapper around SDL. It is used for specification+-- of requirement for making representation from template. This specification+-- is attached to every localizable template in PCLT catalog+data PCLT_ShowDetalizationLevel =+      -- | Plain SDL, nominal. If SDL of representation reciever+      -- is less then that, then template cann't be used in representation+      -- generation.+        PCLT_SDL ShowDetalizationLevel+      -- | \"The requirement is the same as is specified+      -- for referenced template\".+      | PCLT_SDL_ToTemplateLink PCLT_ID+      -- | \"The requirement is the same as is specified a for referenced+      -- template, which is referenced by a @PCSI_PV@ value of referenced+      -- parameter (of current template)\".+      | PCLT_SDL_ToParamCompositeLink PCLT_ParamKey+      -- | In input data for catalog formation the given specification+      -- is errornous.+      -- If config's ("Text.PCLT.Config") parameters+      -- 'Text.PCLT.Config.pcsAllowEmptySDL_parseItByModusMargin' and/or+      -- 'Text.PCLT.Config.pcsAllowUnreadableSDL_parseIdByModusMargin' are+      -- positive, then instead of @PCLT_SDL_Errornous@ the parser+      -- ('str2PCLT_SDL') will use 'Text.PCLT.SDL.marginOfSDLModus' to set+      -- valid specification. When representation generator meets+      -- @PCLT_SDL_Errornous@ it won't use template, and return an error.+      | PCLT_SDL_Errornous PCLT_ErrornousSDL+     deriving (Eq, Show, Typeable)+type PCLT_RequiredShowDetalizationLevel  = PCLT_ShowDetalizationLevel+type PCLT_AllocatedShowDetalizationLevel = PCLT_ShowDetalizationLevel++-- | Raw templates (both localizeds, and localizables).+-- Input data for catalog formation. Used by @HasStaticRawPCLTs@ class+-- (declared in "Text.PCLT.HasStaticRawPCLTs")+data PCLT_RawCatalogData = PCLT_RawCatalogData (Map PCLT_ID (Map LanguageName Lazy.ByteString, PCLT_RequiredShowDetalizationLevel)) deriving (Show, Typeable)++-- | This is a bad result of parsing some 'String'+-- into 'PCLT_ShowDetalizationLevel'. The second argument is this bad input.+data PCLT_ErrornousSDL = UnreadableSDL_ESDL SDLModus String deriving (Eq, Show, Typeable)++-- | A constant currently set to 25. It is used in a parser 'str2PCLT_SDL':+-- if the input is errornous, this much symbols of input are saved+-- in 'UnreadableSDL_ESDL'. If input is bigger, then the saved trunc is+-- tailed with \"...\"+__const_esdl_rawinputshowsize_inShowAsPCSI :: Int+__const_esdl_rawinputshowsize_inShowAsPCSI = 25++-- | Parse 'String' into 'PCLT_ShowDetalizationLevel'. First of all parser+-- tries 'Text.PCLT.SDL.strict_str2sdl'. Then, if failed, parser uses following+-- config entries:+--+-- * 'Text.PCLT.Config.pcsParameterPlaceholderWrapper' -+-- if prefix and postfix of input is this (by default it is \"\@\@\|\"),+-- then it is parsed into 'PCLT_SDL_ToParamCompositeLink'+--+-- * 'Text.PCLT.Config.pcsCompositePlaceholderWrapper' -+-- if prefix and postfix of input is this (by default it is \"\#\#\|\"),+-- then it is parsed into 'PCLT_SDL_ToTemplateLink'+--+-- * 'Text.PCLT.Config.pcsAllowEmptySDL_parseItByModusMargin' -+-- if it is positive and input is empty, then it gets parsed into+-- (@PCLT_SDL $ 'Text.PCLT.SDL.marginOfSDLModus' modus@), where modus+-- is first argument; esle, if parameter is negative and input is empty,+-- it is parsed to 'PCLT_SDL_Errornous'+--+-- * 'Text.PCLT.Config.pcsAllowUnreadableSDL_parseIdByModusMargin' -+-- if it is positive and input is unparsable, then it gets parsed into+-- @'PCLT_SDL' $ 'Text.PCLT.SDL.marginOfSDLModus' modus@, where modus+-- is first argument; esle, if parameter is negative and input is unparsable,+-- it is parsed to 'PCLT_SDL_Errornous'+str2PCLT_SDL :: SDLModus -> String -> PCLT_InnerConfig -> PCLT_ShowDetalizationLevel+str2PCLT_SDL sdlm s cfg =+     let cmpst_phw_str = B.unpack $ pcsCompositePlaceholderWrapper cfg+         param_phw_str = B.unpack $ pcsParameterPlaceholderWrapper cfg+         stripOfWrapper subj0 wrp =+                let wrp_len  = length wrp+                    subj1    = drop wrp_len subj0+                    subj1_len = length subj1+                 in take (subj1_len - wrp_len) subj1+      in case strict_str2sdl s of+             Just  n -> PCLT_SDL n+             Nothing ->+                case isPrefixOf cmpst_phw_str s && isSuffixOf cmpst_phw_str s of+                    True  -> PCLT_SDL_ToTemplateLink (stripOfWrapper s cmpst_phw_str)+                    False -> case isPrefixOf param_phw_str s && isSuffixOf param_phw_str s of+                                 True  -> PCLT_SDL_ToParamCompositeLink (stripOfWrapper s param_phw_str)+                                 False ->+                                     let cond1 = pcsAllowEmptySDL_parseItByModusMargin      cfg && null s+                                         cond2 = pcsAllowUnreadableSDL_parseIdByModusMargin cfg+                                         cond = cond1 || cond2+                                      in case cond of+                                             True  -> PCLT_SDL $ marginOfSDLModus sdlm+                                             False -> PCLT_SDL_Errornous $ UnreadableSDL_ESDL sdlm $ truncLiterary s __const_esdl_rawinputshowsize_inShowAsPCSI++---------------------------------------------------------------------------------+-- * Localizable template++data LocalizableTemplate =+         LocalizableTemplate {+                  pcltLocalizationsMap :: Map LanguageName LocalizedTemplate+                -- | If SDL of representation reciever+                -- is less then that, then template cann't be used in representation+                -- generation.+                , pcltRequiredSDL      :: PCLT_RequiredShowDetalizationLevel+         }+     deriving (Show, Typeable)++
+ Text/PCLT/Template__.hs view
@@ -0,0 +1,132 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# OPTIONS_HADDOCK hide #-}++module Text.PCLT.Template__ where++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString)+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString)+import qualified Data.Map as M+import Data.Map (Map, (!))+import Text.PCLT.SH__+import Text.PCLT.ShowAsPCSI__+import Text.PCLT.SDL+import Text.PCLT.SDL__+import Text.PCLT.Template++------------------------------------------------------------------------------++data PCLT_ShowDetalizationLevel_PCSIWrapper = PCLT_ShowDetalizationLevel_PCSIWrapper PCLT_ShowDetalizationLevel+instance ShowAsPCSI PCLT_ShowDetalizationLevel_PCSIWrapper where+        showAsPCSI (PCLT_ShowDetalizationLevel_PCSIWrapper psdl) =+                thePCSI "PCLT_PSDL" [("psdl", PCSI_PV $ showAsPCSI psdl)]++instance ShowAsPCSI PCLT_ShowDetalizationLevel where+        showAsPCSI psdl = case psdl of+                             PCLT_SDL sdl ->+                                        thePCSI "PCLT_PSDL_SDL" [("sdl", PCSI_PV $ showAsPCSI sdl)]+                             PCLT_SDL_ToTemplateLink tpl_id ->+                                        thePCSI "PCLT_PSDL_CMPST" [("tpl_id", PlainText_PV tpl_id)]+                             PCLT_SDL_ToParamCompositeLink p_name ->+                                        thePCSI "PCLT_PSDL_PARAMCMPST" [("param_name", PlainText_PV p_name)]+                             PCLT_SDL_Errornous err ->+                                        thePCSI "PCLT_PSDL_ERR" [("err_details", PCSI_PV $ showAsPCSI err)]+++instance HasStaticRawPCLTs PCLT_ShowDetalizationLevel where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("PCLT_PSDL", (M.fromList [("rus", B.pack "##|PCLT_PSDL_PREFIX##| @@|psdl@@|"), ("eng", B.pack "##|PCLT_PSDL_PREFIX##| @@|psdl@@|")], str2PCLT_SDL Required_SDLM "##|PCLT_SDL##|" inner_cfg))+                        , ("PCLT_PSDL_PREFIX", (M.fromList [("rus", B.pack "Уровень детализации отображения сообщения из шаблона (определённый при шаблоне, как минимальный необходимый для отображения сообщения): "), ("eng", B.pack "Show detalization level from a message template (specified by the template, as a required minimum for message representation):")], str2PCLT_SDL Required_SDLM "##|PCLT_PSDL##|" inner_cfg))+                        , ("PCLT_PSDL_SDL", (M.fromList [("rus", B.pack "@@|sdl@@|"), ("eng", B.pack "@@|sdl@@|")], str2PCLT_SDL Required_SDLM "##|PCLT_PSDL##|" inner_cfg))+                        , ("PCLT_PSDL_CMPST", (M.fromList [("rus", B.pack "такой же, как для шаблона '@@|tpl_id@@|'"), ("eng", B.pack "the same, as specified for template '@@|tpl_id@@|'")], str2PCLT_SDL Required_SDLM "##|PCLT_PSDL##|" inner_cfg))+                        , ("PCLT_PSDL_PARAMCMPST", (M.fromList [("rus", B.pack "такой же, как для шаблона, который должен быть под параметром '@@|param_name@@|'"), ("eng", B.pack "the same, as specified for template, that is to be put under parameter '@@|param_name@@|'")], str2PCLT_SDL Required_SDLM "##|PCLT_PSDL##|" inner_cfg))+                        , ("PCLT_PSDL_ERR", (M.fromList [("rus", B.pack "ошибка определения уровня ('@@|err_details@@|')"), ("eng", B.pack "SDL specification error ('@@|err_details@@|')")], str2PCLT_SDL Required_SDLM "##|PCLT_PSDL##|" inner_cfg))+                        ]++------------------------------------------------------------------------------++instance ShowAsPCSI PCLT_ErrornousSDL where+        showAsPCSI (UnreadableSDL_ESDL sdlm raw_input) =+            addToPCSI+                [showAsPCSI sdlm]+                (thePCSI "E_PCLT_ESDL" [("sdle_raw_inp", PlainText_PV raw_input)])++instance HasStaticRawPCLTs PCLT_ErrornousSDL where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("PCLT_ESDL", (M.fromList [("rus", B.pack "##|PCLT_ESDL_PREFIX##|@@|pclt_esdl_details@@|."), ("eng", B.pack "##|PCLT_ESDL_PREFIX##|@@|pclt_esdl_details@@|.")], str2PCLT_SDL Required_SDLM "##|PCLT_PSDL##|" inner_cfg))+                        , ("PCLT_ESDL_PREFIX", (M.fromList [("rus", B.pack "Причина ошибочности данного уровня детализации отображения сообщения: "), ("eng", B.pack "Error in definition of level of detalization of representation:")], str2PCLT_SDL Required_SDLM "##|PCLT_ESDL##|" inner_cfg))+                        , ("PCLT_ESDL_UNREAD", (M.fromList [("rus", B.pack "задан нечитаемый уровень. ##|PCLT_SDLM##| Текст заданого: \"@@|sdle_raw_inp@@|\" "), ("eng", B.pack "unreadable level specified. ##|PCLT_SDLM##| Input: \"@@|sdle_raw_inp@@|\"")], str2PCLT_SDL Required_SDLM "##|PCLT_ESDL##|" inner_cfg))+                        ]++------------------------------------------------------------------------------++instance ShowAsPCSI PCS_SpecificMarkings where+        showAsPCSI pcs_sm =+                case pcs_sm of+                    PlainText_LngTplM       -> empPCSI "PCLT_MARKER_PLAINTXT"+                    Parameter_LngTplM       -> empPCSI "PCLT_MARKER_PARAM"+                    Composite_LngTplM       -> empPCSI "PCLT_MARKER_COMPOSITE"+                    Unsupported_LngTplM ssm -> thePCSI "PCLT_MARKER_UNSUP" [("ssm", PCSI_PV $ showAsPCSI ssm)]++data PCS_SpecificMarkings_PCSIWrapped = PCS_SpecificMarkings_PCSIWrapped PCS_SpecificMarkings+instance ShowAsPCSI PCS_SpecificMarkings_PCSIWrapped where+        showAsPCSI (PCS_SpecificMarkings_PCSIWrapped pcs_sm) = thePCSI "PCLT_MARKER" [("pclt_marker_details", PCSI_PV $ showAsPCSI pcs_sm)]++instance HasStaticRawPCLTs PCS_SpecificMarkings where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("PCLT_MARKER", (M.fromList [("rus", B.pack "##|PCLT_MARKER_PREFIX##|@@|pclt_marker_details@@|."), ("eng", B.pack "##|PCLT_MARKER_PREFIX##|@@|pclt_marker_details@@|.")], str2PCLT_SDL Required_SDLM "##|PARSER_SSM##|" inner_cfg))+                        , ("PCLT_MARKER_PREFIX", (M.fromList [("rus", B.pack "PCLT маркер:"), ("eng", B.pack "PCLT marker: ")], str2PCLT_SDL Required_SDLM "##|PCLT_MARKER##|" inner_cfg))+                        , ("PCLT_MARKER_PLAINTXT", (M.fromList [("rus", B.pack "обычный текст"), ("eng", B.pack "plain text")], str2PCLT_SDL Required_SDLM "##|PCLT_MARKER##|" inner_cfg))+                        , ("PCLT_MARKER_PARAM", (M.fromList [("rus", B.pack "параметр"), ("eng", B.pack "parameter")], str2PCLT_SDL Required_SDLM "##|PCLT_MARKER##|" inner_cfg))+                        , ("PCLT_MARKER_COMPOSITE", (M.fromList [("rus", B.pack "композит"), ("eng", B.pack "composite")], str2PCLT_SDL Required_SDLM "##|PCLT_MARKER##|" inner_cfg))+                        , ("PCLT_MARKER_UNSUP", (M.fromList [("rus", B.pack "неподдерживаемый маркер \"@@|ssm@@|\""), ("eng", B.pack "unsupported marker \"@@|ssm@@|\"")], str2PCLT_SDL Required_SDLM "##|PCLT_MARKER##|" inner_cfg))+                        ]++------------------------------------------------------------------------------++instance ShowAsPCSI PCLT_ParserLowLevelFailure where+        showAsPCSI pclt_pllf =+                case pclt_pllf of+                    UnexpectedParserResult_PLLF_PCLT parse_result_str -> thePCSI "E_PCLT_PLLF_UNEXP"  [("parse_result_str", PlainText_PV parse_result_str)]+                    BadMarker_PLLF_PCLT               ssm s chunk_idx -> thePCSI "E_PCLT_PLLF_BADSSM" [("ssm", PCSI_PV $ showAsPCSI ssm), ("chunk_idx", PlainText_PV $ show chunk_idx)]+data PCLT_ParserLowLevelFailure_PCSIWrapped = PCLT_ParserLowLevelFailure_PCSIWrapped PCLT_ParserLowLevelFailure+instance ShowAsPCSI PCLT_ParserLowLevelFailure_PCSIWrapped where+        showAsPCSI (PCLT_ParserLowLevelFailure_PCSIWrapped pclt_pllf) = thePCSI "E_PCLT_PLLF" [("pclt_pllf_details", PCSI_PV $ showAsPCSI pclt_pllf)]++instance HasStaticRawPCLTs PCLT_ParserLowLevelFailure where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [+                          ("E_PCLT_PLLF", (M.fromList [("rus", B.pack "##|E_PCLT_PLLF_PREFIX##|@@|pclt_pllf_details@@|."), ("eng", B.pack "##|E_PCLT_PLLF_PREFIX##|@@|pclt_pllf_details@@|.")], str2PCLT_SDL Required_SDLM "##|LLEXCPT##|" inner_cfg))+                        , ("E_PCLT_PLLF_PREFIX", (M.fromList [("rus", B.pack "Произошла ошибка в результате применения парсера, который разделяет обычный текст, параметры и композиты:"), ("eng", B.pack "An error occurred when applying parser, that separates plain text, parameters and composites: ")], str2PCLT_SDL Required_SDLM "##|E_PCLT_PLLF##|" inner_cfg))+                        , ("E_PCLT_PLLF_UNEXP", (M.fromList [("rus", B.pack "парсер вернул ненормальное состояние \"@@|parse_result_str@@|\""), ("eng", B.pack "parser returned an unexpected state \"@@|parse_result_str@@|\"")], str2PCLT_SDL Required_SDLM "##|E_PCLT_PLLF##|" inner_cfg))+                        , ("E_PCLT_PLLF_BADSSM", (M.fromList [("rus", B.pack "плохой маркер у куска текста (позиция: @@|chunk_idx@@|): @@|ssm@@|"), ("eng", B.pack "bad chunk marker (position: @@|chunk_idx@@|): @@|ssm@@|")], str2PCLT_SDL Required_SDLM "##|E_PCLT_PLLF##|" inner_cfg))+                        ]++------------------------------------------------------------------------------++data PCLTRawCatalog__Text_PCLT_Template = PCLTRawCatalog__Text_PCLT_Template+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_Template where+     widenessOfStaticRawPCLTsSet _ = Module_RPSW+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                        [ getStaticRawPCLTs inner_cfg (undefined :: PCLT_ErrornousSDL)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCS_SpecificMarkings)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLT_ParserLowLevelFailure)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLT_ShowDetalizationLevel)+                        ]-- i wish i knew an easy way how to achieve a smaller code of this by using a "map (getStaticRawPCLTs inner_cfg) [...]" function
+ doinst.sh view
@@ -0,0 +1,8 @@+#! /bin/sh+clear++sudo runghc Setup unregister+sudo runghc Setup configure --user+sudo runghc Setup build+sudo runghc Setup haddock+sudo runghc Setup install
+ examples/HelloWorld/HelloWorld.NoPCLT.hs view
@@ -0,0 +1,102 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++-- This code is WITHOUT extending application with PCLT. A code that uses subject package is listed in "HelloWorld.hs" file++module HelloWorld where++import Control.Exception++-----------------------------------------------------+-----------------------------------------------------+-- Application specific data structures++-- \/ data+data HelloWorld = HelloWorld++-- \/ errors+type WorldName = String+type WorldIndex = Int+data HelloWorldError =+          NoWorld_HWE+        | AmbiguousChoiceOfWorlds_HWE (WorldName, WorldIndex) (WorldName, WorldIndex) [(WorldName, WorldIndex)]+        | SomeVeryStrangeError_HWE Int String Bool (Maybe Bool) (Maybe Bool) SomeException+        | FailedDueToErrorInSubsystem_HWE ErrorInSubsystem++data ErrorInSubsystem =+          ErrorType1_EIS+        | ErrorType2_EIS+        | FailedDueToErrorInSubsubsystem_EIS ErrorInSub_sub_system++data ErrorInSub_sub_system =+          ErrorType1_EISS+        | ErrorType2_EISS++-----------------------------------------------------+-----------------------------------------------------+-- Functional part of app++type SayHelloWorld_Mode = Int+sayHelloWorld :: SayHelloWorld_Mode -> Either HelloWorldError HelloWorld+sayHelloWorld mode =+        case mode of+            0 -> Right HelloWorld+            1 -> Left NoWorld_HWE+            2 -> Left $ AmbiguousChoiceOfWorlds_HWE ("RealWorld", 1) ("VirtualWorld", 2) [("OtherWorld1", 3), ("OtherWorld2", 4), ("OtherWorld3", 5)]+            3 -> Left $ SomeVeryStrangeError_HWE 5789 "Noise..." True (Just True) Nothing (SomeException DivideByZero)+            4 -> Left $ FailedDueToErrorInSubsystem_HWE ErrorType1_EIS+            5 -> Left $ FailedDueToErrorInSubsystem_HWE ErrorType2_EIS+            6 -> Left $ FailedDueToErrorInSubsystem_HWE $ FailedDueToErrorInSubsubsystem_EIS ErrorType1_EISS+            7 -> Left $ FailedDueToErrorInSubsystem_HWE $ FailedDueToErrorInSubsubsystem_EIS ErrorType2_EISS++showHelloWorld :: SayHelloWorld_Mode -> String+showHelloWorld mode = show $ sayHelloWorld mode++main = let iterate_ = do+                  putStrLn "\n---------------------------------\n"+                  putStrLn "Input sayHelloWorld mode (0-7; '-1' to exit): "+                  mode <- readLn+                  case mode >= 0 && mode <= 7 of+                      True -> do putStrLn $ showHelloWorld mode+                                 putStrLn "\n---------------------------------\n"+                                 iterate_+                      False -> case mode == (-1) of+                                   True  -> return ()+                                   False -> iterate_+        in iterate_++-----------------------------------------------------+-----------------------------------------------------+-- Representations++instance Show HelloWorld where+     show hw = "Hello world!"++instance Show HelloWorldError where+     show hwe = "Hello world failure!\nReason:\n" +++        case hwe of+            NoWorld_HWE -> "no world!"+            AmbiguousChoiceOfWorlds_HWE (wn1, wi1) (wn2, wi2) other_worlds -> "ambiguous choice of worlds!\nWorld 1: " ++ show (wn1, wi1) ++ ".\nWorld 2: " ++ show (wn2, wi2) ++ ".\nOther worlds: " ++ show other_worlds+            SomeVeryStrangeError_HWE i s b mb_b1 mb_b2 sm_excpt -> "some very strange error! Data: " ++ show (i, s, b, mb_b1, mb_b2, sm_excpt)+            FailedDueToErrorInSubsystem_HWE eis -> " failed due to error(s) in subsystem!\nLower level exception message:\n" ++ show eis++instance Show ErrorInSubsystem where+     show eis = "Subsystem failure!\nReason:\n" +++        case eis of+            ErrorType1_EIS -> "error of type 1."+            ErrorType2_EIS -> "error of type 2."+            FailedDueToErrorInSubsubsystem_EIS eiss -> "failed due to error(s) in subSUBsystem!\nLower level exception message:\n" ++ show eiss++instance Show ErrorInSub_sub_system where+     show eis = "SubSUBsystem failure!\nReason:\n " +++        case eis of+            ErrorType1_EISS -> "error of type 1."+            ErrorType2_EISS -> "error of type 2."
+ examples/HelloWorld/HelloWorld.PCLTCatalog.ods view

binary file changed (absent → 37900 bytes)

+ examples/HelloWorld/HelloWorld.hs view
@@ -0,0 +1,477 @@+{-+Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>++All rights reserved.++For license and copyright information, see the file COPYRIGHT+-}++--------------------------------------------------------------------------+--------------------------------------------------------------------------++{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}++-- Without extending HelloWorld application with PCLT catalog, it would look like the code in "HelloWorld.NoPCLT.hs" file++module HelloWorld where++-----------------------------------------------------+-- Modules necessary for our PCLTCatalog+import Prelude hiding (putStrLn) -- Prelude putStrLn doesn't work properly with utf8+import Data.ByteString.Lazy.UTF8++import qualified Data.ByteString.Lazy.UTF8.Unified as Lazy     (ByteString) -- all catalog business is done using lazy ByteStrings+import qualified Data.ByteString.Lazy.UTF8.Unified as B hiding (ByteString) -- since ByteStrings (and System.IO) is not very friendly to unicode symbols "utf8-string" package us used+import qualified Data.Map as M+import Data.Map (Map, (!))+import System.IO.UTF8 hiding (readLn)++import           Text.PCLT -- this module exports most important PCLT modules - there (in Text.PCLT) are some comments about exported modules+import qualified Text.ConstraintedLBS as CB -- a constrainting (the constraint here is on it's size) wrapper for a lazy ByteString (LBS) - this container is used for messages generated from PCLT templates++-----------------------------------------------------+-----------------------------------------------------+-- Application specific modules+import Control.Exception++-----------------------------------------------------+-----------------------------------------------------+-- Application specific data structures++-- \/ data+data HelloWorld = HelloWorld++-- \/ errors+type WorldName = String+type WorldIndex = Int+data HelloWorldError =+          NoWorld_HWE+        | AmbiguousChoiceOfWorlds_HWE (WorldName, WorldIndex) (WorldName, WorldIndex) [(WorldName, WorldIndex)]+        | SomeVeryStrangeError_HWE Int String Bool (Maybe Bool) (Maybe Bool) SomeException+        | FailedDueToErrorInSubsystem_HWE ErrorInSubsystem++data ErrorInSubsystem =+          ErrorType1_EIS+        | ErrorType2_EIS+        | FailedDueToErrorInSub_sub_system_EIS ErrorInSub_sub_system++data ErrorInSub_sub_system =+          ErrorType1_EISS+        | ErrorType2_EISS++-----------------------------------------------------+-----------------------------------------------------+-- Functional part of app++type SayHelloWorld_Mode = Int+sayHelloWorld :: SayHelloWorld_Mode -> Either HelloWorldError HelloWorld+sayHelloWorld mode =+        case mode of+            0 -> Right HelloWorld+            1 -> Left NoWorld_HWE+            2 -> Left $ AmbiguousChoiceOfWorlds_HWE ("RealWorld", 1) ("VirtualWorld", 2) [("OtherWorld1", 3), ("OtherWorld2", 4), ("OtherWorld3", 5)]+            3 -> Left $ SomeVeryStrangeError_HWE 5789 "Noise..." True (Just True) Nothing (SomeException DivideByZero)+            4 -> Left $ FailedDueToErrorInSubsystem_HWE ErrorType1_EIS+            5 -> Left $ FailedDueToErrorInSubsystem_HWE ErrorType2_EIS+            6 -> Left $ FailedDueToErrorInSubsystem_HWE $ FailedDueToErrorInSub_sub_system_EIS ErrorType1_EISS+            7 -> Left $ FailedDueToErrorInSubsystem_HWE $ FailedDueToErrorInSub_sub_system_EIS ErrorType2_EISS++acquireCatalog :: StdErr_CLBS -> (ShowDetalizationLevel, LanguageName) -> (PCLT_Catalog, StdErr_CLBS)+acquireCatalog stderr_clbs (stderr_sdl, stderr_lng) =+        let catalog_id = 777+            catalog_config = defaultPCLTInnerConfig { -- config, that influences catalog formation and messages generation+                                                     -- a catalog always hasa default language (primary)+                                                     -- by default a strict orientation of other languages on this primary language is turned on - for every nonprimary language template, it's sets of parameters and composites must be equal to the sets in primary language+                                                     -- this stricness is easy to turn off or to add exclusions to (when not to be strict on composites and parameters sets)+                                                     -- (but one can't turn off (or make exclusions for) the constraint, according to which, a template can't be added to a catalog if it's version for primary language is nowhere (in catalog, in added template) to be found)+                                  pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets = -- let's add one such exclusion: we don't want catalogto be strict on a parameter "__row_idx" in template "E_HWE_AMBWRLDCH_OW"+                                        (pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets defaultPCLTInnerConfig) {+                                                soExcludingCompParameters = soExcludingCompParameters (pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets defaultPCLTInnerConfig)+                                                                         ++ [("E_HWE_AMBWRLDCH_OW", "__row_idx")]+                                        }+                                }++            -- \/ these here aren't to be believed to be lightweight operations - don't use them too often, just intitialize catalog once when program starts+            (catalog1, stderr_clbs2) = initDefaultCatalog_2 -- it contains temlates of messages used by PCLT pacakage itself (error messages and some shows)+                                                catalog_config+                                                catalog_id+                                                (stderr_clbs, stderr_sdl, stderr_lng) -- collect error messages if any+            (catalog2, stderr_clbs3) = addFromHSRTToCatalog_2+                                                PCLTRawCatalog__HelloWorld -- an instance of HasStaticRawPCLTs, a data type to which we bind all the application specifc templates+                                                catalog1 -- we add it to the initial version of catalog+                                                (stderr_clbs2, stderr_sdl, stderr_lng) -- collect error messages if any++         in (catalog2, stderr_clbs3)++showHelloWorld :: SayHelloWorld_Mode -> (StdOut_CLBS, StdErr_CLBS) -> (ShowDetalizationLevel, LanguageName, PCLT_Catalog) -> (StdOut_CLBS, StdErr_CLBS) -- first CLBS - result; second - representation of catalog errors list+showHelloWorld mode (stdout_clbs, stderr_clbs) (sdl, lng, catalog) =+        let err_or_HelloWorld = sayHelloWorld mode+            (new_stdout_clbs, new_stderr_clbs) = -- note: here in stderr_clbs goes only catalog-works errors, HelloWorldError (if any) goes into stdout_clbs+                pcsi2text_plus_errs_2+                        (stdout_clbs, stderr_clbs)+                        (showAsPCSI err_or_HelloWorld) -- this means, thet err_or_HelloWorld is of ShowAsPCSI class - the according instance is declared in the bottom of this example+                        (sdl, lng)+                        catalog+         in (new_stdout_clbs, new_stderr_clbs) -- these are showable, and one may print them "CB.putStrLn stdout_clbs"++main = run_test "rus" (SDL 15000) -- possible values here: ["rus", "eng", "hs_"] x [Zero_SDL, One_SDL, SDL <Int>, InfinitelyBig_SDL]++run_test _lng _sdl =+       let my_lng = _lng+           my_sdl = _sdl+           my_stderr_clbs_size = 50000+           my_stdout_clbs_size = 50000+           stderr_clbs0 = newCLBS my_stderr_clbs_size+           stdout_clbs0 = newCLBS my_stdout_clbs_size+           (catalogue, stderr_clbs1) = acquireCatalog stderr_clbs0 (my_sdl, my_lng)+           iterate_ = do+                  putStrLn "----New-iteration:---------------"+                  putStrLn "Input sayHelloWorld mode (0-7; '-1' to exit): "+                  mode <- readLn+                  case mode >= 0 && mode <= 7 of+                      True -> do let (stdout_clbs1, stderr_clbs1) =+                                           showHelloWorld+                                                mode+                                                (stdout_clbs0, stderr_clbs0)+                                                (my_sdl, my_lng, catalogue)+                                 putStrLn "----Errors:----------------------"+                                 putStrLn $ toString $ clbsLBS stderr_clbs1+                                 putStrLn "----Output:----------------------"+                                 putStrLn $ toString $ clbsLBS stdout_clbs1+                                 --putStrLn $ show $ toString $ clbsLBS stdout_clbs1+                                 iterate_+                      False -> case mode == (-1) of+                                   True  -> return ()+                                   False -> iterate_+        in do putStrLn ("Language, SDL (detailization level): " ++ show (_lng, _sdl))+              putStrLn "----Init-errors:-----------------"+              putStrLn $ show stderr_clbs1+              putStrLn "----Cycle-start:-----------------"+              iterate_++-----------------------------------------------------+-----------------------------------------------------+-- Representations+-- Note: it's a recommended practice to put these declarations below into a separate file...+-- IMPORTANT!!! : It is highly recommended to use ISO 639(3) standard for language names, since PCLT-DB package that addons a DBMS powers to PCLT catalogs management is oriented on 3 letters (not bigger) language names. Without modifications PCLT-DB won't work for bigger (then 3-letters) names.++instance (ShowAsPCSI HelloWorldError, ShowAsPCSI HelloWorld) => ShowAsPCSI (Either HelloWorldError HelloWorld) where+        showAsPCSI err_or_hw =+                case err_or_hw of+                    Right hw  -> showAsPCSI hw+                    Left  hwe -> showAsPCSI hwe++instance ShowAsPCSI HelloWorld where+     showAsPCSI hw = empPCSI "HW"+instance HasStaticRawPCLTs HelloWorld where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [ ( "HW"+                          , ( M.fromList+                                  [ ("rus", B.pack "Привет, Мир!")+                                  , ("eng", B.pack "Hello world!")+                                  , ("hs_", B.pack "HelloWorld")+                                  ]+                            , str2PCLT_SDL Required_SDLM "0" inner_cfg+                            )+                          )+                        ]++instance ShowAsPCSI HelloWorldError where+     showAsPCSI hwe = thePCSI "E_HWE" [ ("hwe_details_pcsi", PCSI_PV hwe_details_pcsi) ]+        where+           hwe_details_pcsi =+                case hwe of+                    NoWorld_HWE ->+                        empPCSI "E_HWE_NOWRLD"+                    AmbiguousChoiceOfWorlds_HWE (wn1, wi1) (wn2, wi2) other_worlds ->+                        thePCSI "E_HWE_AMBWRLDCH"+                                [ ("w_name_1", PlainText_PV wn1)+                                , ("w_idx_1" , PlainText_PV $ show wi1)+                                , ("w_name_2", PlainTextLBS_PV $ B.pack wn1) -- lazy ByteString is also welcome+                                , ("w_idx_2" , PlainTextLBS_PV $ B.pack $ show wi2)+                                , ("other_worlds", case null other_worlds of -- this is a #1 way to include templates in a template - through parameters using PCSI_PV and/or PCSIList_PV parameter value types+                                                       True  -> PCSI_PV $ empPCSI "E_HWE_AMBWRLDCH_NOMORE"+                                                       False ->+                                                            Indented_PV 3 $ -- a way to insert 3 whitespaces after each '\n' in a string that results from what's wrapped in+                                                                  PCSIList_PV+                                                                       (map (\ (w_name, w_idx) ->+                                                                                thePCSI+                                                                                     "E_HWE_AMBWRLDCH_OW"+                                                                                     [ ("w_name", PlainText_PV w_name)+                                                                                     , ("w_idx" , PlainText_PV $ show w_idx)+                                                                                     ]+                                                                            )+                                                                            other_worlds+                                                                       )+                                                                       (PCSI_PV $ empPCSI "E_HWE_AMBWRLDCH_OW_SEP") -- this is a separator between rows in representation (put Nothing_PV here, if you want to omit separator)+                                  )+                                ]+                    SomeVeryStrangeError_HWE i s b mb_b1 mb_b2 sm_excpt ->+                        thePCSI "E_HWE_STRNGERR"+                                [ ("int"     , PlainText_PV $ show i)+                                , ("str"     , PlainText_PV s)+                                , ("bool"    , PCSI_PV $ showAsPCSI b) -- Text.PCLT.ShowAsPCSI__ module conains ShowAsPCSI instances for some basic general types (Bool, ShowAsPCSI a => Maybe a, SomeException)+                                , ("mb_bool1", PCSI_PV $ showAsPCSI mb_b1) -- such treatment is possible only if type under Maybe is of ShowAsPCSI class+                                , ("mb_bool2", PCSI_PV $ showAsPCSI mb_b2)+                                , ("sm_excpt", PCSI_PV $ showAsPCSI sm_excpt) -- uses SomeException instaniation from Text.PCLT.ShowAsPCSI__+                                ]+                    FailedDueToErrorInSubsystem_HWE eis ->+                        [showAsPCSI eis] `addToPCSI` empPCSI "E_HWE_EIS" -- if summed PCSIs parameters names happen coincide, the walue is kept from first parameter, from earliest PCSI from list++-- E_HWE_STRNGERR template refers to some predefined standard templates, assumming, that Bool, (Maybe a) and SomeException already are instances of ShowAsPCSI class.+-- And they really are instaniated in Text.PCLT.ShowAsPCLT__ module. However, HasStaticRawPCLTs instances of Bool, (Maybe a) and SomeException support only 2 languages: eng, rus.+-- But we use 3 languages here: eng, rus and haskell!+-- So, in order to make this example complete, we also need to add representations for Bool, (Maybe a) and SomeException types in a 'haskell' language:+data PCLTRawCatalog__Text_PCLT_ShowAsPCSI_GeneralCommons__addon_for_haskell_lng = PCLTRawCatalog__Text_PCLT_ShowAsPCSI_GeneralCommons__addon_for_haskell_lng+instance HasStaticRawPCLTs PCLTRawCatalog__Text_PCLT_ShowAsPCSI_GeneralCommons__addon_for_haskell_lng where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+             PCLT_RawCatalogData $ M.fromList+                                        [+                                          ("TRUE", (M.fromList [("hs_", B.pack "True")], str2PCLT_SDL Required_SDLM "one" inner_cfg))+                                        , ("FALSE", (M.fromList [("hs_", B.pack "False")], str2PCLT_SDL Required_SDLM "##|TRUE##|" inner_cfg))++                                        , ("MAYBE_A", (M.fromList [("hs_", B.pack "@@|maybe_cnstr@@|")], str2PCLT_SDL Required_SDLM "##|TRUE##|" inner_cfg))+                                        , ("MAYBE_JUST", (M.fromList [("hs_", B.pack "Just @@|a@@|")], str2PCLT_SDL Required_SDLM "##|MAYBE_A##|" inner_cfg))+                                        , ("MAYBE_NOTHING", (M.fromList [("hs_", B.pack "Nothing")], str2PCLT_SDL Required_SDLM "##|MAYBE_A##|" inner_cfg))++                                        , ("LLEXCPT", (M.fromList [("hs_", B.pack "SomeException (ErrorCall \"@@|excpt_msg@@|\")")], str2PCLT_SDL Required_SDLM "1000" inner_cfg))+                                        ]++instance HasStaticRawPCLTs HelloWorldError where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [ ( "E_HWE"+                          , ( let same_tpl = B.pack "##|E_HWE_PREFIX##|@@|hwe_details_pcsi@@|" -- the E_HWE_PREFIX is a composite; the hwe_details_pcsi is a parameter+                               in M.fromList+                                  [ ("rus", same_tpl)+                                  , ("eng", same_tpl)+                                  , ("hs_", same_tpl)+                                  ]+                            , str2PCLT_SDL Required_SDLM "10" inner_cfg -- == PCLT_SDL $ SDL 10+                            )+                          )+                        , ( "E_HWE_PREFIX"+                          , ( M.fromList+                                  [ ("rus", B.pack "Приветствие мира не удалось!\nПричина: ")+                                  , ("eng", B.pack "Hello world failure!\nReason: ")+                                  , ("hs_", B.empty)+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_HWE##|" inner_cfg -- the SDL must be the same as specified for E_HWE template+                                                                                 -- == PCLT_SDL_ToTemplateLink "E_HWE"+                            )+                          )+                        , ( "E_HWE_NOWRLD"+                          , ( M.fromList+                                  [ ("rus", B.pack "некого приветствовать (нет мира)!")+                                  , ("eng", B.pack "no world!")+                                  , ("hs_", B.pack "NoWorld_HWE")+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_HWE##|" inner_cfg+                            )+                          )+                        , ( "E_HWE_AMBWRLDCH"+                          , ( M.fromList+                                  [ ("rus", B.pack "неясно, какой из миров приветствовать - их несколько!\nПервый мир: [имя: '@@|w_name_1@@|', индекс: @@|w_idx_1@@|].\nВторой мир: [имя: '@@|w_name_2@@|', индекс: @@|w_idx_2@@|].\nА так же эти миры: \n   @@|other_worlds@@|.")+                                  , ("eng", B.pack "ambiguous choice of worlds!\nFirst world: [name: '@@|w_name_1@@|', index: @@|w_idx_1@@|].\nSecond world: [name: '@@|w_name_2@@|', index: @@|w_idx_2@@|].\nAnd also these worlds: \n   @@|other_worlds@@|.")+                                  , ("hs_", B.pack "AmbiguousChoiceOfWorlds_HWE\n   (\"@@|w_name_1@@|\", @@|w_idx_1@@|)\n   (\"@@|w_name_2@@|\", @@|w_idx_2@@|)\n   [ @@|other_worlds@@|\n   ]")+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_HWE##|" inner_cfg+                            )+                          )+                        , ( "E_HWE_AMBWRLDCH_OW"+                          , ( M.fromList+                                  [ ("rus", B.pack "@@|__row_idx@@|) мир [имя: '@@|w_name@@|', индекс: @@|w_idx@@|]") -- __row_idx is an implicit parameter, that can be used by templates that are guaranteed to be wrapped in a PCSIList_PV (not PVList_PV !!!) parameter value wrapper+                                  , ("eng", B.pack "@@|__row_idx@@|) world [name: '@@|w_name@@|', index: @@|w_idx@@|]")+                                  , ("hs_", B.pack "(\"@@|w_name@@|\", @@|w_idx@@|)")+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_HWE_AMBWRLDCH##|" inner_cfg+                            )+                          )+                        , ( "E_HWE_AMBWRLDCH_OW_SEP"+                          , ( M.fromList+                                  [ ("rus", B.pack "\n")+                                  , ("eng", B.pack "\n")+                                  , ("hs_", B.pack "\n, ")+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_HWE_AMBWRLDCH_OW##|" inner_cfg+                            )+                          )+                        , ( "E_HWE_AMBWRLDCH_NOMORE"+                          , ( M.fromList+                                  [ ("rus", B.pack "список пуст.")+                                  , ("eng", B.pack "empty list.")+                                  , ("hs_", B.empty)+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_HWE_AMBWRLDCH_OW##|" inner_cfg+                            )+                          )+                        , ( "E_HWE_STRNGERR"+                          , ( M.fromList+                                  [ ("rus", B.pack "какая-то странная непонятная ошибка! Данные: @@|int@@| \"@@|str@@|\" @@|bool@@| (@@|mb_bool1@@|) (@@|mb_bool2@@|) { @@|sm_excpt@@| }")+                                  , ("eng", B.pack "some very strange error! Data: @@|int@@| \"@@|str@@|\" @@|bool@@| (@@|mb_bool1@@|) (@@|mb_bool2@@|) { @@|sm_excpt@@| }")+                                  , ("hs_", B.pack "SomeVeryStrangeError_HWE @@|int@@| \"@@|str@@|\" @@|bool@@| (@@|mb_bool1@@|) (@@|mb_bool2@@|) (@@|sm_excpt@@|)")+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_HWE##|" inner_cfg+                            )+                          )+                        , ( "E_HWE_EIS"+                          , ( M.fromList+                                  [ ("rus", B.pack "ошибка в подсистеме!\nТекст исключения уровнем ниже:\n##|E_EIS##|")+                                  , ("eng", B.pack "failed due to error(s) in subsystem!\nLower level exception message:\n##|E_EIS##|")+                                  , ("hs_", B.pack "FailedDueToErrorInSubsystem_HWE (##|E_EIS##|)") -- include a template E_EIS here (note: it's representation together with E_HWE_EIS will share one parameters values map)+                                                                                                        -- this is a #2 way to include templates in a template - as composites+                                                                                                        -- the difference from #1 way is such, that in #2 template and it's composites share one same parameters map, but in #1 each inclusion has it's own parameters map+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_HWE##|" inner_cfg+                            )+                          )+                        ]++instance ShowAsPCSI ErrorInSubsystem where+     showAsPCSI eis = thePCSI "E_EIS" [ ("eis_details_pcsi", PCSI_PV eis_details_pcsi) ]+        where+           eis_details_pcsi =+                case eis of+                    ErrorType1_EIS ->+                        empPCSI "E_EIS_ET1"+                    ErrorType2_EIS ->+                        empPCSI "E_EIS_ET2"+                    FailedDueToErrorInSub_sub_system_EIS eiss ->+                        thePCSI "E_EIS_EISS" [("e_eiss", PCSI_PV $ showAsPCSI eiss)]+instance HasStaticRawPCLTs ErrorInSubsystem where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [ ( "E_EIS"+                          , ( let same_tpl = B.pack "##|E_EIS_PREFIX##|@@|eis_details_pcsi@@|"+                               in M.fromList+                                  [ ("rus", same_tpl)+                                  , ("eng", same_tpl)+                                  , ("hs_", same_tpl)+                                  ]+                            , str2PCLT_SDL Required_SDLM "20" inner_cfg+                            )+                          )+                        , ( "E_EIS_PREFIX"+                          , ( M.fromList+                                  [ ("rus", B.pack "Сбой в подсистеме!\nПричина: ")+                                  , ("eng", B.pack "Subsystem failure!\nReason: ")+                                  , ("hs_", B.empty)+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_EIS##|" inner_cfg+                            )+                          )+                        , ( "E_EIS_ET1"+                          , ( M.fromList+                                  [ ("rus", B.pack "ошибка типа #1!")+                                  , ("eng", B.pack "error of type #1!")+                                  , ("hs_", B.pack "ErrorType1_EIS")+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_EIS##|" inner_cfg+                            )+                          )+                        , ( "E_EIS_ET2"+                          , ( M.fromList+                                  [ ("rus", B.pack "ошибка типа #2!")+                                  , ("eng", B.pack "error of type #2!")+                                  , ("hs_", B.pack "ErrorType2_EIS")+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_EIS##|" inner_cfg+                            )+                          )+                        , ( "E_EIS_EISS"+                          , ( M.fromList+                                  [ ("rus", B.pack "сбой в подПОДсистеме! Текст исключения уровнем ниже: @@|e_eiss@@|")+                                  , ("eng", B.pack "failed due to error(s) in subSUBsystem!\nLower level exception message:\n@@|e_eiss@@|")+                                  , ("hs_", B.pack "FailedDueToErrorInSub_sub_system_EIS (@@|e_eiss@@|)")+                                  -- i could have included representation of ErrorInSub_sub_system as a composite here ##|E_EISS##| (the same as we did in E_HWE_EIS template)+                                  -- but for example purpose i do the same work in a different way through @@|e_eiss@@| parameter+                                  -- this way is less strict because user may choose not to (forget to) put under a parameter "e_eiss" the template "E_EISS"+                                  ]+                            , str2PCLT_SDL Required_SDLM "@@|e_eiss@@|" inner_cfg -- == PCLT_SDL_ToParamCompositeLink "e_eiss"+                              -- now if user forgets to put a PCSI_PV in the value of param "e_eiss", the engine will complain with an error+                              -- because here we specify, that SDL requirement must be the same as for TEMPLATE that is under "e_eiss" parameter+                            )+                          )+                        ]++instance ShowAsPCSI ErrorInSub_sub_system where+     showAsPCSI eiss = thePCSI "E_EISS" [ ("eiss_details_pcsi", PCSI_PV eiss_details_pcsi) ]+        where+           eiss_details_pcsi =+                case eiss of+                    ErrorType1_EISS ->+                        empPCSI "E_EISS_ET1"+                    ErrorType2_EISS ->+                        empPCSI "E_EISS_ET2"+instance HasStaticRawPCLTs ErrorInSub_sub_system where+     getStaticRawPCLTs inner_cfg _ = flip (,) [] $+                PCLT_RawCatalogData $ M.fromList+                        [ ( "E_EISS"+                          , ( let same_tpl = B.pack "##|E_EISS_PREFIX##|@@|eiss_details_pcsi@@|"+                               in M.fromList+                                  [ ("rus", same_tpl)+                                  , ("eng", same_tpl)+                                  , ("hs_", same_tpl)+                                  ]+                            , str2PCLT_SDL Required_SDLM "30" inner_cfg+                            )+                          )+                        , ( "E_EISS_PREFIX"+                          , ( M.fromList+                                  [ ("rus", B.pack "Сбой в подПОДсистеме!\nПричина: ")+                                  , ("eng", B.pack "SubSUBsystem failure!\nReason: ")+                                  , ("hs_", B.empty)+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_EISS##|" inner_cfg+                            )+                          )+                        , ( "E_EISS_ET1"+                          , ( M.fromList+                                  [ ("rus", B.pack "ошибка типа #1!")+                                  , ("eng", B.pack "error of type #1!")+                                  , ("hs_", B.pack "ErrorType1_EISS")+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_EISS##|" inner_cfg+                            )+                          )+                        , ( "E_EISS_ET2"+                          , ( M.fromList+                                  [ ("rus", B.pack "ошибка типа #2!")+                                  , ("eng", B.pack "error of type #2!")+                                  , ("hs_", B.pack "ErrorType2_EISS")+                                  ]+                            , str2PCLT_SDL Required_SDLM "##|E_EISS##|" inner_cfg+                            )+                          )+                        ]++------------------------------------+-- Gathering all HasStaticRawPCLTs insances and sticking them to one data type. This way we may scope all our templates, for example, when we need a single reference on catalog input data (as in addFromHSRTToCatalog)+data PCLTRawCatalog__HelloWorld = PCLTRawCatalog__HelloWorld+instance HasStaticRawPCLTs PCLTRawCatalog__HelloWorld where -- here we gather all the local to module HasStaticRawPCLTs instances, so tha it's easy to mention them by one word+     widenessOfStaticRawPCLTsSet _ = Module_RPSW -- this is apurely informative declaration, no functions make use of it so far+     getStaticRawPCLTs inner_cfg _ =+                mergeRawCatalogDataSets2 True+                        [ getStaticRawPCLTs inner_cfg (undefined :: HelloWorld)+                        , getStaticRawPCLTs inner_cfg (undefined :: HelloWorldError)+                        , getStaticRawPCLTs inner_cfg (undefined :: ErrorInSubsystem)+                        , getStaticRawPCLTs inner_cfg (undefined :: ErrorInSub_sub_system)+                        , getStaticRawPCLTs inner_cfg (undefined :: PCLTRawCatalog__Text_PCLT_ShowAsPCSI_GeneralCommons__addon_for_haskell_lng)+                        ]+-- if we also add (undefined :: PCLTRawCatalog__PCLT_InitialDefaultCatalog) in this list,+-- then instead of using "initDefaultCatalog_2" and "addFromHSRTToCatalog_2" we can use just single "initCatalogFromHSRT_2"++{-+-------------------------------------------------------------------------+-- CONCLUSION++One may see here, that adding a multilinguality to a system is not a task for a lazy guy.+While developing this (PCLT engine) package a recomended practice was explicated:+1) Separate program and representations - put all ShowAsPCSI and HasStaticRawPCLTs instances to a separate files.+   For example, author would make his file into two: "HelloWorld.hs" and "HelloWorld__.hs". The HelloWorld__ should have imported at least "Text.PCLT.SH__" and HelloWorld+2) Keep all templates in tables in OpenOffice Calc file (or Excel's analogue). An example of such file is provided in package folder, in [initial_data/PCLT.InitialCatalog.ods] - it is filled with templates data actually used by PCLT engine.++This package comes before another one - "PCLT-DB", where all templates are kept in a PostgreSQL v8.4.(not less) data base, and it is possible to run a thread, that regularly checks, if a catalog in operative memory is up tu date, and if not, rereads it from DB.+Check it in Hackage.+-}
+ initial_data/PCLT.PCLTCatalog.ods view

binary file changed (absent → 71362 bytes)

+ models/PCLT.BriefModulesStructure.odg view

binary file changed (absent → 23762 bytes)

+ models/PCLT.BriefModulesStructure.odg.png view

binary file changed (absent → 288971 bytes)