۲۵ - ۱۱موند ترانسفورمرها در عمل

‏‎MaybeT‎‏ در عمل

اینها چندتا مثال از ‏‎MaybeT‎‏ در عمل هستن؛ ما توضیحی براشون نمیدیم و فرصت میدیم خودتون اگه خواستین بیشتر تحقیق کنین. منبعِ کُدها رو کامنت کردیم.

-- github.com/wavewave/hoodle-core
recentFolderHook
  :: MainCoroutine (Maybe FilePath)
recentFolderHook = do
  xstate <- get
  (r :: Maybe FilePath) <- runMaybeT $ do
    hset <- hoist (view hookset xstate)
    rfolder <-
      hoist (H.recentFolderHook hset)
    liftIO rfolder
  return r

-- github.com/devalot/hs-exceptions
-- src/maybe.hs
addT :: FilePath
     -> FilePath
     -> IO (Maybe Integer)
addT f1 f2 = runMaybeT $ do
  s1 <- sizeT f1
  s2 <- sizeT f2
  return (s1 + s2)

-- wavewave/ghcjs-dom-delegator
-- example/Example.hs
main :: IO ()
main = do
  clickbarref <-
    asyncCallback1 AlwaysRetain clickbar
  clickbazref <-
    asyncCallback1 AlwaysRetain clickbaz
  r <- runMaybeT $ do
    doc <- MaybeT currentDocument
    bar <- lift . toJSRef
           =<< MaybeT
                 (documentQuerySelector doc
                   (".bar" :: JSString))
    baz <- lift . toJSRef
           =<< MaybeT
                 (documentQuerySelector doc
                   (".baz" :: JSString))
    lift $ do
      ref <- newObj
      del <- delegator ref
      addEvent bar "click" clickbarref
      addEvent baz "click" clickbazref

  case r of
    Nothing -> print "something wrong"
    Just _ -> print "welldone"

توسعه‌ی موقتِ ساختار

با اینکه عموماً موند ترانسفورمرها برای تعریفِ یه بافت ِ بزرگ برای یه برنامه شناخته میشن (بخصوص با چیزهایی مثل ‏‎ReaderT‎‏) راه‌های دیگه‌ای هم وجود دارن. یکی از الگو‌های مفید، توسعه‌ی موقتِ ساختار ِ اضافه‌ست که جلوی تکرارنوشت رو می‌گیره. یه مثال از چنین الگویی با استفاده از ‏‎Maybe‎‏ و ‏‎scotty‎‏:

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.IO.Class
import Data.Maybe (fromMaybe) 
import Data.Text.Lazy (Text)
import Web.Scotty

param' :: Parsable a
       => Text -> ActionM (Maybe a)
param' k = rescue (Just <$> param k)
                  (const (return Nothing))

main = scotty 3000 $ do
  get "/:word" $ do
    beam' <- param' "word"
    let beam = fromMaybe "" beam'
    i <- param' "num"
    liftIO $ print (i :: Maybe Integer)
    html $
      mconcat ["<h1>Scotty, ",
               beam,
               " me up!</h1>"]

این کار می‌کنه، اما اگه چندتا چیز داشتیم که ‏‎ActionM (Maybe...)‎‏ خروجی می‌دادن و می‌خواستیم به ازای شکست ِ یکی‌شون همه‌شون شکست بخورن، زود پیچیده میشد. حالا با ‏‎MaybeT‎‏ یه کارِ مشابه می‌کنیم:

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Data.Maybe (fromMaybe)
import Data.Text.Lazy (Text)
import Web.Scotty

param' :: Parsable a
       => Text -> MaybeT ActionM a
param' k = MaybeT $
             rescue (Just <$> param k)
                    (const (return Nothing))

type Reco =
  (Integer, Integer, Integer, Integer)

main = scotty 3000 $ do
  get "/:word" $ do
    beam <- param "word"
    reco <- runMaybeT $ do
      a <- param' "1"
      liftIO $ print a
      b <- param' "2"
      c <- param' "3"
      d <- param' "4"
      (lift . lift) $ print b
      return ((a, b, c, d) :: Reco)
    liftIO $ print reco
    html $
      mconcat ["<h1>Scotty, ",
               beam,
               " me up!</h1>"]

اینجا چندتا نکته‌ی مهم هست:

‏‎ExceptT‎‏، یا همون ‏‎EitherT‎‏ در عمل

مثالی که با ‏‎scotty‎‏ و ‏‎Maybe‎‏ زدیم خیلی راضی‌کننده نیست، چون در صورتِ شکست، تنها اطلاعاتی که به کاربر میده ‏‎Nothing‎‏ ِه. کلاً باید تکلیفِ ‏‎Maybe‎‏ رو زود مشخص کرد (معمولاً همون جایی که درست میشه) تا جلوی مقادیرِ ‏‎Nothing‎‏ ای که معلوم نیست از کجا پیداشون شده گرفته بشه. ارائه‌ی مقادیرِ ‏‎Nothing‎‏ به کاربرِ نهایی هم کار خوبی نیست. خوشبختانه برای اتصال-کوتاه‌های گویاتر (شکست‌های گویاتر)، ‏‎Either‎‏ رو داریم!

باز هم ‏‎scotty‎‏

برای نشون دادنِ این مورد دوباره از ‏‎scotty‎‏ استفاده می‌کنیم. یه بار دیگه مثالِ ساده میزنیم:

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.IO.Class
import Data.Text.Lazy (Text)
import Web.Scotty

param' :: Parsable a
       => Text -> ActionM (Either String a)
param' k =
  rescue (Right <$> param k)
          (const
           (return (Left $ "The key: "
                           ++ show k
                           ++ " was missing!")))

main = scotty 3000 $ do
  get "/:word" $ do
    beam <- param "word"
    a <- param' "1"
    let a' = either (const 0) id a
    liftIO $ print (a :: Either String Int) 
    liftIO $ print (a' :: Int)
    html $
      mconcat ["<h1>Scotty, ",
               beam,
               " me up!</h1>"]

دقت کنین که برای دسترسی به مقدارِ ‏‎Int‎‏، باید ‏‎Either‎‏ رو دستی فولد می‌کردیم. ولی در کُدِ واقعی سعی کنین از اینطور مقادیرِ پیش‌فرض اجتناب کنین. اگه تعداد زیاد بشه، زود ناجور میشه.

حالا همون کار رو این بار با ‏‎ExceptT‎‏ از ‏‎transformers‎‏ انجام بدیم. به خاطر داشته باشین که ‏‎ExceptT‎‏ یه اسمِ دیگه برای ‏‎EitherT‎‏ ِه:

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Data.Text.Lazy (Text) 
import qualified Data.Text.Lazy as TL
import Web.Scotty

param' :: Parsable a
       => Text -> ExceptT String ActionM a
param' k =
  ExceptT $
    rescue (Right <$> param k)
            (const
             (return
              (Left $ "The key: "
                      ++ show k
                      ++ " was missing!")))

type Reco =
  (Integer, Integer, Integer, Integer)

tshow = TL.pack . show

main = scotty 3000 $ do
  get "/" $ do
    reco <- runExceptT $ do
      a <- param' "1"
      liftIO $ print a
      b <- param' "2"
      c <- param' "3"
      d <- param' "4"
      (lift . lift) $ print b
      return ((a, b, c, d) :: Reco)
    case reco of
      (Left e) -> test (TL.pack e) 
      (Right r) ->
        html $
          mconcat ["<h1>Success! Reco was: ",
                   tshow r,
                   "</h1>"]

اگه یه درخواست مثلِ این بهش بدین:

http://localhost:3000/?1=1

دنبال ۲ می‌گرده، چون بعد از ۱، پارامتر ۲ رو خواستین.

اگه یه درخواست مثلِ این بهش بدین:

http://localhost:3000/?1=1&2=2&3=3&4=4

باید چنین پاسخی ببینین:

Success! Reco was: (1,2,3,4)

یه بار دیگه از یه بایند ِ گُنده (زیرِ ‏‎ExceptT‎‏) بهره بردیم.

کدِ یه ذره پیشرفته

از یکی از کُدهای شان چالمرز.

ممکنه در چنین فضایی ‏‎EitherT‎‏ کاربرد داشته باشه:

type Et a = Either SDLErr IO a

mkWindow :: HasSDLErr m =>
            String
         -> CInt -> CInt
         -> m SDL.Window
mkRenderer :: HasSDLErr m
           => SDL.Window -> m SDL.Renderer

hasSDLErr :: (MonadIO m, MonadError e m)
          => (a -> b)
          -> (a -> Bool)
          -> e -> IO a -> m b
hasSDLErr g f e a =
  liftIO a
  >>= \r ->
        bool (return $ g r)
             (throwError e) $ f r

class (MonadIO m, MonadError SDLErr m)
   => HasSDLErr m where
  decide  :: (a -> Bool)
          -> SDLErr -> IO a -> m a
  decide' :: (Eq n, Num n)
          => SDLErr -> IO n -> m ()

instance HasSDLErr
  (EitherT SDLErr IO) where
    decide  = hasSDLErr id
    decide' = hasSDLErr (const ()) (/= 0)

و در عمل:

initialise :: Et (SDL.Window,SDL.Renderer)
initialise = do
  initSDL [SDL.SDL_INIT_VIDEO]
  win <-
    mkWindow "Meteor!"
             screenHeight
             screenWidth
  rdr <- mkRenderer win
  return (win,rdr)

createMeteor :: IO (Either SDLErr MeteorS)
createMeteor = do
  eM <- runEitherT initialise
  retrun $ mkMeteor <$> eM
  where
    emptyBullets = V.empty

    mkMeteor (w,r) = MeteorS w r
                     getInitialPlayer
                     emptyBullets
                     getInitialMobs
                     False