voidlizard

let looong2 =
  Eliom_predefmod.Xhtml.register_new_service
    ~path:["looong2"]
    ~get_params:unit
    (fun sp () () ->
      Lwt_preemptive.detach (fun () -> ()) () >>= fun () ->
      return
        (html
          (head (title (pcdata "")) [])
          (body [h1 [pcdata

voidlizard

fmap (\x -> "xmlforest(" ++ concat (intersperse "," x) ++ ")") (fmap ((map (\(x,_) -> x))) ((describeTable c "vcurrency")))

voidlizard

insertEntity :: Context -> String -> ServerPartT IO Response
insertEntity serv w = 
    methodM GET >> do withData (\d -> handle serv w d) 
    where handle ctx t (TestGet p) = do
            x <- liftIO (doInsertIntoTable ctx t p)
--- написав это сам,  Дик Бёрд (ну или Бивис) впервые поверил, что он сможет освоить хаскель
            res <- case x of 
                    Nack(x) -> do fail x; return "<error/>" -- и особенно вот это
                    Ack  _  -> return "<ok/>"
            ok $  contentTypeXml $ toResponse res

voidlizard

module ConnPool ( newConnPool, withConn, delConnPool ) where

import Control.Concurrent
import Control.Exception
import Control.Monad (replicateM)
import Database.HDBC

data Pool a =
    Pool { poolMin :: Int, poolMax :: Int, poolUsed :: Int, poolFree :: [a] }

voidlizard

WITH 
schedule1 AS (
SELECT 
	q2.object_id,
	q2.trip_id,
	q2.rule_id,
	rule_type,
	rule_name,
	greatest(q2.tff, q2.tf) as tff,

voidlizard

-- create or replace view vschedule4 as 

create view vwtf1 as 

WITH sched1 as (

 SELECT q.date AS trip_date, s.gos_number, bt.name AS bus_model, sh.name AS school_name, f_name_fmt(p.*) AS driver_name, t.name AS trip_name, g.name AS group_name, first_value(q.name) OVER w AS first_point, timezone('UTC'::text, first_value(q.start_time) OVER w)::timestamp without time zone AS first_point_plan, timezone('UTC'::text, first_value(q.time_actual) OVER w)::timestamp without time zone AS first_point_actual, last_value(q.name) OVER w1 AS last_point, timezone('UTC'::text, last_value(q.start_time) OVER w1)::timestamp without time zone AS last_point_plan, timezone('UTC'::text, last_value(q.time_actual) OVER w1)::timestamp without time zone AS last_point_actual, sum(q.fuckup_num) OVER w1 AS fuckup_num_sum, 
        CASE
            WHEN sum(q.fuckup_num) OVER w1 > 0 THEN 'да'::text
            ELSE 'нет'::text

voidlizard

module AppState where

import Happstack.Server.SimpleHTTP (ServerPartT)
import Control.Concurrent.MVar
import Control.Monad.Reader
import qualified Data.Map as M
import qualified Data.Set as S
import Db (Context)

type MyServerPartT = ServerPartT (ReaderT AppState IO)

voidlizard

main :: IO ()
main = do
    putStrLn "Init sessions..."
    ctx <- newDbContext viewKeys
    sd  <- loadSessionData ctx
    st  <- initState ctx $ sessionsFromList sd

    let reloadSessions = do
        putStrLn "Reload sessions"
--        ctx' <- newDbContext viewKeys

voidlizard

updateSessionsToState :: AppState -> Sessions -> IO () 
updateSessionsToState s ns = do
    liftIO $ putMVar (sessions s) ns

voidlizard

test :: MyServerPartT Response 
test = methodM [POST, GET] >> do
        decodeBody reqPolicy
        auth (Check ["test", "*"])
        ok $ toResponse "Okay"