PCLT-DB-0.1: examples/HelloWorld/HelloWorld.hs
{-
Copyright (C) 2009 Andrejs Sisojevs <andrejs.sisojevs@nextmail.ru>
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.
-}