{- Copyright (C) 2009 Andrejs Sisojevs All rights reserved. For license and copyright information, see the file COPYRIGHT -} -------------------------------------------------------------------------- -------------------------------------------------------------------------- {-# LANGUAGE DeriveDataTypeable #-} -- 1) HelloWorld program that doesn't use PCLT and PCLT-DB packages is to be found in PCLT packages examples directory. -- 2) HelloWorld program that uses only PCLT (but no PCLT-DB) package is to be found in PCLT packages examples directory. All the explanations about using PCLT are also there, but here are omited. -- 3)< HelloWorld program that uses both PCLT and PCLT-DB packages is the one you are currently looking at. -- It's best to understand (1) and (2) before trying to understand what's going on in this listing here. -- Before running this exaple user must run HelloWorld.sql module HelloWorld where ----------------------------------------------------- -- Modules necessary for our PCLTCatalog import Control.Concurrent import Database.HDBC import Database.HDBC.PostgreSQL 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.Typeable import qualified Text.ConstraintedLBS as CB import Database.PCLT -- this module exports most required PCLT-DB modules import Text.PCLT import Prelude hiding (putStrLn, readLn) import System.IO hiding (putStrLn, readLn, hPutStr) import System.IO.UTF8 -- putStrLn from here will be used to correctly output russian letters ----------------------------------------------------- ----------------------------------------------------- -- Application specific modules import Control.Exception import HelloWorld_Data -- Application specific ADTs and type synonyms import HelloWorld__ -- instances for ShowAsPCSI and HasStaticRawPCLTs ----------------------------------------------------- ----------------------------------------------------- -- 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 ------------------------------------- --some constants required by catalogizing system __db_name = "pcltcatalogs" __dbms_user = "user_pcltcatalogs_data_reader" __dbms_user_password = "data_reader_password" __connection_string_delimiter = " " __connectionString = "dbname=" ++ __db_name ++ __connection_string_delimiter __connectionString' = __connectionString ++ "user=" ++ __dbms_user ++ __connection_string_delimiter __connectionString'' = __connectionString' ++ "password=" ++ __dbms_user_password ++ __connection_string_delimiter __update_frequency_sec = 8 __my_lng = "rus" -- possible values: "eng", "rus", "hs_" __my_sdl = InfinitelyBig_SDL -- possible values: Zero_SDL < One_SDL < SDL Int < InfinitelyBig_SDL __my_stderr_clbs_size = 50000 __my_stdout_clbs_size = 50000 __catalog_id = 50 type Microseconds = Int data CatalogControl = -- MVar of this will be in between HelloWorld mainmodule and thread that will regularly update catalog from DB CatalogControl { catcCatalogMV :: MVar PCLT_Catalog , catcUpdateFrequency :: MVar Microseconds , catcUpdatorLoopHolder :: MVar Bool -- initialized as True; whenever we putthis to False, the next iteration on of update cycle begins with service termination , catcUpdatorTaskTriggerChan :: Chan Bool -- between iterations service awaits on this channel; we regularly send thereit gets catcUpdatorLoopHolder value; if False is sent, updator finishes , catcUpdatorTaskTriggerThreadID :: ThreadId , catcUpdatorThreadID :: ThreadId } deriving (Typeable) acquireCatalog :: StdErr_CLBS -> (ShowDetalizationLevel, LanguageName) -> IO (CatalogControl, MVar StdErr_CLBS) acquireCatalog stderr_clbs (stderr_sdl, stderr_lng) = do let catalog_config = defaultPCLTInnerConfig { pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets = (pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets defaultPCLTInnerConfig) { soExcludingCompParameters = soExcludingCompParameters (pcsStrictOrient_ofParamsAndCmpsts_onDfltLngTplsSets defaultPCLTInnerConfig) ++ [("E_HWE_AMBWRLDCH_OW", "__row_idx")] -- this is described in a HelloWorld that uses only PCLT (but no PCLT-DB) } } updateFrequency_mv <- newMVar (__update_frequency_sec * 1000000) updatorLoopHolder_mv <- newMVar True let taskEnablerCycle :: Chan Bool -> IO () taskEnablerCycle ch = do freq <- readMVar updateFrequency_mv threadDelay freq enabled_isit <- readMVar updatorLoopHolder_mv putStrLn "#catalog updated...#" writeChan ch enabled_isit case enabled_isit of True -> taskEnablerCycle ch False -> return () let taskEnablerThread :: IO (Chan Bool, ThreadId) -- this thread will regularly stimulate iterations of catalog updator taskEnablerThread = do ch <- newChan tm_TID <- forkIO $ taskEnablerCycle ch return (ch, tm_TID) (aliveChan, tm_TID) <- taskEnablerThread -- thread started stderr_clbs_mv <- newMVar stderr_clbs let errorsReporter :: PCLT_Catalog -> CatalogUpdateFromDBErrors -> IO () -- ths is how the catalog updator service must react on catalog read failure (due to error); if catalog isn't read, the previous version of catalog is used here errorsReporter cat cue = modifyMVar_ stderr_clbs_mv (\ _errs_clbs -> return $ pcsi2text_plus_errs_1 _errs_clbs (showAsPCSI cue) (__my_sdl, __my_lng) cat ) serviceStart :: IO CatalogControl serviceStart = do db_conn <- connectPostgreSQL __connectionString'' serv_db_conn <- clone db_conn -- good practice for cases, when have multiple same connections - make a prototype and clone it as many times as needed (cat_mv, us_TID) <- runCatalogUpdatorService (__catalog_id, catalog_config, PCLTRawCatalog__HelloWorld) -- With this catalog updator will start it's service. This way we ensure, that even if DB connection fails, we still have a catalog available. (serv_db_conn, True) -- True says, that server must disconnect assigned to it DB connection, when it finishes errorsReporter aliveChan disconnect db_conn -- prototype isn't needed anymore return CatalogControl { catcCatalogMV = cat_mv , catcUpdateFrequency = updateFrequency_mv , catcUpdatorLoopHolder = updatorLoopHolder_mv , catcUpdatorTaskTriggerChan = aliveChan , catcUpdatorTaskTriggerThreadID = tm_TID , catcUpdatorThreadID = us_TID } cc <- serviceStart return (cc, stderr_clbs_mv) showHelloWorld :: SayHelloWorld_Mode -> (StdOut_CLBS, StdErr_CLBS) -> (ShowDetalizationLevel, LanguageName, PCLT_Catalog) -> (StdOut_CLBS, StdErr_CLBS) showHelloWorld mode (stdout_clbs, stderr_clbs) (sdl, lng, catalog) = -- showHelloWorld here doesn't differ the HelloWorld, that uses only PCLT (but no PCLT-DB) - it is described there let err_or_HelloWorld = sayHelloWorld mode (new_stdout_clbs, new_stderr_clbs) = pcsi2text_plus_errs_2 (stdout_clbs, stderr_clbs) (showAsPCSI err_or_HelloWorld) (sdl, lng) catalog in (new_stdout_clbs, new_stderr_clbs) main = run_test __my_lng __my_sdl run_test _lng _sdl = let stderr_clbs0 = newCLBS __my_stderr_clbs_size stdout_clbs0 = newCLBS __my_stdout_clbs_size in do (catalog_control, stderr_clbs_mv) <- acquireCatalog stderr_clbs0 (__my_sdl, __my_lng) putStrLn ("Language, SDL (detailization level), update frequency (sec): " ++ show (_lng, _sdl, __update_frequency_sec)) putStrLn "----Init-errors:-----------------" stderr_clbs1 <- modifyMVar stderr_clbs_mv (\ stderr_clbs1 -> return (stderr_clbs0, stderr_clbs1)) putStrLn $ show stderr_clbs1 dump stderr_clbs1 putStrLn "----Cycle-start:-----------------" let iterate_ = do putStrLn "----New-iteration:---------------" putStrLn "Input sayHelloWorld mode (0-7; '-1' to exit): " mode <- readLn case mode >= 0 && mode <= 7 of True -> do (stdout_clbs1, stderr_clbs1) <- -- stderr_clbs1 accumulates all errors from work of catalog udator servece, and independently also accumulates errors from interaction with user withMVar (catcCatalogMV catalog_control) (\ catalog -> modifyMVar stderr_clbs_mv (\ _stderr_clbs -> return ( stderr_clbs0 -- in each iteration of interaction with user, stderr gets shown and emptyed , showHelloWorld mode (stdout_clbs0, _stderr_clbs) (__my_sdl, __my_lng, catalog) ) ) ) putStrLn "----Errors:----------------------" putStrLn_paged 12 $ show stderr_clbs1 putStrLn "----Output:----------------------" putStrLn $ show stdout_clbs1 iterate_ False -> case mode == (-1) of True -> modifyMVar_ (catcUpdatorLoopHolder catalog_control) (\ _ -> return False) -- tell updator services to finish False -> iterate_ iterate_ 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...-------" dump :: Show a => a -> IO () dump a = do h <- openFile "./dump.out" WriteMode -- WriteMode -- AppendMode hPutStr h $ show a hClose h infixr 1 << (<<) :: Monad m => m b -> m a -> m b f << x = x >> f ----------------------------------------------------- ----------------------------------------------------- -- Representations -- moved to file HelloWorld__.hs {- ------------------------------------------------------------------------- -- CONCLUSION It is a lot of work to play multilinguality, using PCLT-DB. The ShowAsPCSI instaniations, HasStaticRawPCLTs instaniations, templates management... however PCLT-DB was built with an aim, that once catalog is setup, tested and put to work, it's management cost is minimal possible. When using PCLT only (no DB) the following management points are there: a) Choose catalog configuration in haskell code. b) Adjust (together with (c)) templates in an electronic table (f.e. using OpenOffice Calc). c) Adjust (together with (b)) templates "calls" in ShowAsPCSI instances. d) From (b) fill in HasStaticRawPCLTs instances e) Use HasStaticRawPCLTs instances to unite into module-wide and package-wide raw template sets. When using PCLT-DB the following management points there are: f) Choose catalog configuration and store it in DB. g) Adjust (together with (c)) templates in DB. j) Use collections in DB in order to unite module-wide and package-wide template sets. i) If needed, manage and configure representation policies in DB - a way to set different schemes of detalization requirements "with one key press". Possible economies: (f) makes unnecessary (a) (g) makes unnecessary (b) (j) makes unnecessary (d) and (e) (f,g,j) is considered to require less code and management cost than (a,b,d,e) One might get confused: why then Database.PCLT.runCatalogUpdatorService input still requires a some PCLT_InnerConfig and an instance of HasStaticRawPCLTs, if all this is now kept in DB? The answer: 0) If DB for some reasons is unawailable, catalog will be formed from the data hardcoded in HasStaticRawPCLTs instances, and using some hardcoded config. 1) Despite (a,b,d,e) becomes unnecessary, one may still choose to use them. (a,b,d,e) and (f,g,j) may work together - if DB is off, hardcoded version (a,b,d,e) of catalog is always available! Double cost for double reliability, why not, if resources allow. 2) But even if programmer doesn't want to manage (a,b,d,e), it is asummed, that at least templates used by PCLT/-DB itselt are nice to have operatively available. In this case on input to Database.PCLT.runCatalogUpdatorService programmer puts Database.PCLT.PCLTRawCatalog__Database_PCLT_UpdatableCatalog Text.PCLT.Config.defaultPCLTInnerConfig. , which are templates set used by PCLT and PCLT-DB themselves and default config. They are already defined, and one only needs to reference them. -}