diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -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. + + + Copyright (C) + + 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. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! diff --git a/COPYRIGHT b/COPYRIGHT new file mode 100644 --- /dev/null +++ b/COPYRIGHT @@ -0,0 +1,18 @@ +Copyright (C) 2009 Andrejs Sisojevs + + 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. + diff --git a/Data/ByteString/Lazy/UTF8/Unified.hs b/Data/ByteString/Lazy/UTF8/Unified.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Lazy/UTF8/Unified.hs @@ -0,0 +1,96 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Data/MyHelpers.hs b/Data/MyHelpers.hs new file mode 100644 --- /dev/null +++ b/Data/MyHelpers.hs @@ -0,0 +1,304 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/PCLT.cabal b/PCLT.cabal new file mode 100644 --- /dev/null +++ b/PCLT.cabal @@ -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 +Maintainer: Andrejs Sisojevs +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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runghc + +import Distribution.Simple +main = defaultMain diff --git a/Text/ConstraintedLBS.hs b/Text/ConstraintedLBS.hs new file mode 100644 --- /dev/null +++ b/Text/ConstraintedLBS.hs @@ -0,0 +1,148 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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) diff --git a/Text/PCLT.hs b/Text/PCLT.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT.hs @@ -0,0 +1,126 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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__ diff --git a/Text/PCLT/Catalog.hs b/Text/PCLT/Catalog.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/Catalog.hs @@ -0,0 +1,66 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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) + +----------------------------------------------------------------- + diff --git a/Text/PCLT/CatalogFromHSRT.hs b/Text/PCLT/CatalogFromHSRT.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/CatalogFromHSRT.hs @@ -0,0 +1,121 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 + ) diff --git a/Text/PCLT/CatalogFromHSRT__.hs b/Text/PCLT/CatalogFromHSRT__.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/CatalogFromHSRT__.hs @@ -0,0 +1,44 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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) ] diff --git a/Text/PCLT/CatalogMaths.hs b/Text/PCLT/CatalogMaths.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/CatalogMaths.hs @@ -0,0 +1,96 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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) + diff --git a/Text/PCLT/CatalogMaths__.hs b/Text/PCLT/CatalogMaths__.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/CatalogMaths__.hs @@ -0,0 +1,87 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/Catalog__.hs b/Text/PCLT/Catalog__.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/Catalog__.hs @@ -0,0 +1,86 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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@@|». Версия шаблона на НЕосновном языке отвергнута (если такая строгость вас неустраивает, подрегулируйте параметр в конфигурации каталога)"), ("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 )")], 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 diff --git a/Text/PCLT/CommonTypes.hs b/Text/PCLT/CommonTypes.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/CommonTypes.hs @@ -0,0 +1,34 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/Config.hs b/Text/PCLT/Config.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/Config.hs @@ -0,0 +1,252 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 + } diff --git a/Text/PCLT/HasStaticRawPCLTs.hs b/Text/PCLT/HasStaticRawPCLTs.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/HasStaticRawPCLTs.hs @@ -0,0 +1,72 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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) diff --git a/Text/PCLT/InitialDefaultCatalog.hs b/Text/PCLT/InitialDefaultCatalog.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/InitialDefaultCatalog.hs @@ -0,0 +1,55 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/MakeCatalog.hs b/Text/PCLT/MakeCatalog.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/MakeCatalog.hs @@ -0,0 +1,499 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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) diff --git a/Text/PCLT/MakeCatalog__.hs b/Text/PCLT/MakeCatalog__.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/MakeCatalog__.hs @@ -0,0 +1,155 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/MakeMessage.hs b/Text/PCLT/MakeMessage.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/MakeMessage.hs @@ -0,0 +1,510 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 ++ "" + 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 = "<>" + 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 ++ "") + (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 + ------------------------------------------------------ diff --git a/Text/PCLT/MakeMessage2.hs b/Text/PCLT/MakeMessage2.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/MakeMessage2.hs @@ -0,0 +1,123 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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)) diff --git a/Text/PCLT/MakeMessage__.hs b/Text/PCLT/MakeMessage__.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/MakeMessage__.hs @@ -0,0 +1,168 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/PCSI.hs b/Text/PCLT/PCSI.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/PCSI.hs @@ -0,0 +1,100 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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] diff --git a/Text/PCLT/Parser/AdvancedSepBy.hs b/Text/PCLT/Parser/AdvancedSepBy.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/Parser/AdvancedSepBy.hs @@ -0,0 +1,209 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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." diff --git a/Text/PCLT/Parser/ParserInternals.hs b/Text/PCLT/Parser/ParserInternals.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/Parser/ParserInternals.hs @@ -0,0 +1,339 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/SDL.hs b/Text/PCLT/SDL.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/SDL.hs @@ -0,0 +1,100 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 + diff --git a/Text/PCLT/SDL__.hs b/Text/PCLT/SDL__.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/SDL__.hs @@ -0,0 +1,86 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/SH__.hs b/Text/PCLT/SH__.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/SH__.hs @@ -0,0 +1,28 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/ShowAsPCSI.hs b/Text/PCLT/ShowAsPCSI.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/ShowAsPCSI.hs @@ -0,0 +1,24 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/ShowAsPCSI__.hs b/Text/PCLT/ShowAsPCSI__.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/ShowAsPCSI__.hs @@ -0,0 +1,136 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/Text/PCLT/Template.hs b/Text/PCLT/Template.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/Template.hs @@ -0,0 +1,280 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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) + + diff --git a/Text/PCLT/Template__.hs b/Text/PCLT/Template__.hs new file mode 100644 --- /dev/null +++ b/Text/PCLT/Template__.hs @@ -0,0 +1,132 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 diff --git a/doinst.sh b/doinst.sh new file mode 100644 --- /dev/null +++ b/doinst.sh @@ -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 diff --git a/examples/HelloWorld/HelloWorld.NoPCLT.hs b/examples/HelloWorld/HelloWorld.NoPCLT.hs new file mode 100644 --- /dev/null +++ b/examples/HelloWorld/HelloWorld.NoPCLT.hs @@ -0,0 +1,102 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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." diff --git a/examples/HelloWorld/HelloWorld.PCLTCatalog.ods b/examples/HelloWorld/HelloWorld.PCLTCatalog.ods new file mode 100644 Binary files /dev/null and b/examples/HelloWorld/HelloWorld.PCLTCatalog.ods differ diff --git a/examples/HelloWorld/HelloWorld.hs b/examples/HelloWorld/HelloWorld.hs new file mode 100644 --- /dev/null +++ b/examples/HelloWorld/HelloWorld.hs @@ -0,0 +1,477 @@ +{- +Copyright (C) 2009 Andrejs Sisojevs + +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 , 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. +-} diff --git a/initial_data/PCLT.PCLTCatalog.ods b/initial_data/PCLT.PCLTCatalog.ods new file mode 100644 Binary files /dev/null and b/initial_data/PCLT.PCLTCatalog.ods differ diff --git a/models/PCLT.BriefModulesStructure.odg b/models/PCLT.BriefModulesStructure.odg new file mode 100644 Binary files /dev/null and b/models/PCLT.BriefModulesStructure.odg differ diff --git a/models/PCLT.BriefModulesStructure.odg.png b/models/PCLT.BriefModulesStructure.odg.png new file mode 100644 Binary files /dev/null and b/models/PCLT.BriefModulesStructure.odg.png differ