FP_HSE2020Fall_12pr

Fp12pr.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE InstanceSigs #-}

module Fp12pr where

import Control.Monad.Trans ( MonadIO(..), MonadTrans(..) )
import Control.Monad.Identity ( Identity(Identity) ) 
import Control.Monad.State
    ( StateT, MonadState(..), modify, State )
import Control.Monad.Fail ( MonadFail(..) )


{-
Какие из законов класса типов MonadPlus выполняются для спиcка? 
типа Maybe? 
Приведите доказательство или опровергающий пример.

--Left and Right Zero
mzero >>= k  ==  mzero
v >> mzero   ==  mzero
--Left Distribution
(a `mplus` b) >>= k  ==  (a >>= k) `mplus` (b >>= k)
--Left Catch law
return a `mplus` b  ==  return a
-}

newtype StrRdrT m a = StrRdrT { runStrRdrT :: String -> m a }

{-
GHCi> :t StrRdrT   
StrRdrT :: (String -> m a) -> StrRdrT m a
GHCi> :t runStrRdrT
runStrRdrT :: StrRdrT m a -> String -> m a
-}


{-
Реализуйте для произвольной монады \mintinline{haskell}!m! 
представителя класса типов \mintinline{haskell}!Monad! 
для \mintinline{haskell}!StrRdrT m :: * -> *!. 
-}

instance Monad m => Monad (StrRdrT m) where
  return :: a -> StrRdrT m a
  return  = undefined
  
  (>>=) :: StrRdrT m a -> (a -> StrRdrT m b) -> StrRdrT m b
  (>>=) = undefined

--  fail :: String -> StrRdrT m a
--  fail = undefined  -- начиная с 8.6 следует реализовывать в MonadFail

instance Monad m => Functor (StrRdrT m) where
  fmap  = undefined
instance Monad m => Applicative (StrRdrT m) where
  pure = undefined
  (<*>) = undefined

{-
Поскольку \mintinline{haskell}!StrRdr! не подразумевает специфического умения обрабатывать ошибки,
семантика \mintinline{haskell}!MonadFail! должна протаскиваться из внутренней монады. Реализуйте 
соответствующего представителя
-}
instance MonadFail m => MonadFail (StrRdrT m)  where
  fail :: String -> StrRdrT m a
  fail = undefined


srtTst :: StrRdrT Identity Int
srtTst = do 
  x <- StrRdrT $ Identity <$> length
  y <- return 10
  return $ x + y
{-
GHCi> runStrRdrT srtTst "ABCDE"
Identity 15
GHCi> runIdentity (runStrRdrT srtTst "ABCDE")
15
GHCi> (runIdentity . runStrRdrT srtTst) "ABCDE" 
15
-}

-- технически в качестве кочерыжки можно использовать любую монаду, например список:
failTst :: StrRdrT [] Integer
failTst = do
  'z' <- StrRdrT id
  return 42
{-
GHCi> runStrRdrT failTst "zanzibar"
[42,42]
GHCi> runStrRdrT failTst "zzz..."  
[42,42,42]
GHCi> runStrRdrT failTst "ABCD"  
[]
-}







{-
Напишите функции \mintinline{haskell}!askStrRdr! 
\mintinline{haskell}!asksStrRdr!
обеспечивающую трансформер \mintinline{haskell}!StrRdrT! 
стандартным интерфейсом обращения к окружению:
-}
 
askStrRdr :: Monad m => StrRdrT m String
askStrRdr = undefined

asksStrRdr :: Monad m => (String -> a) -> StrRdrT m a
asksStrRdr = undefined
 
{-
Введите для удобства упаковку для \mintinline{haskell}!StrRdrT Identity!
и напишите функцию запускающую вычисления в этой монаде
-}

type StrRdr = StrRdrT Identity

runStrRdr :: StrRdr a -> String -> a
runStrRdr = undefined

srtTst' :: StrRdr (String,Int)   
srtTst'  = do 
  env <- askStrRdr
  len <- asksStrRdr length
  return (env,len)
 {-
GHCi> runStrRdr srtTst' "ABCD"
("ABCD",4)
-}

stSrTst :: StateT Int StrRdr Int
stSrTst = do 
  a <- get
  n <- lift $ asksStrRdr length
  modify (+n)
  return a
{-
GHCi> runStrRdr (runStateT stSrTst 33) "ABCD"
(33,37)
-}




{-
В последнем примере функция 
\mintinline{text}!lift :: (MonadTrans t, Monad m) => m a -> t m a! 
позволяла поднять вычисление из
внутренней монады (в примере это был \mintinline{haskell}!StrRdr!) во
внешний трансформер (\mintinline{haskell}!StateT Int!).
Это возможно, поскольку для трансформера \mintinline{haskell}!StateT s!
реализован представитель класса типов \mintinline{haskell}!MonadTrans!.
Сделайте трансформер \mintinline{haskell}!StrRdrT! представителем
класса \mintinline{haskell}!MonadTrans!, так чтобы 
можно было поднимать вычисления из произвольной внутренней 
монады в наш трансформер:
-}

instance MonadTrans StrRdrT where
  lift = undefined

srStTst :: StrRdrT (State Int) (Int,Int)
srStTst = do 
  lift $ state $ \s -> ((),s + 40)
  m <- lift get
  n <- asksStrRdr length
  lift $ put $ m + n
  return (m,n)
{-
GHCi> runState (runStrRdrT srStTst "ABCD") 2
((42,4),46)
GHCi> runState (runStrRdrT srStTst "ABCDE") 2
((42,5),47)
-}


{-
Избавьтесь от необходимости 
ручного подъема операций вложенной монады \mintinline{haskell}!State! , 
сделав трансформер \mintinline{haskell}!LoggT!, 
примененный к монаде с интерфейсом \mintinline{haskell}!MonadState!, 
представителем этого (\mintinline{haskell}!MonadState!) класса типов:
-}

instance MonadState s m => MonadState s (StrRdrT m) where
  get   = undefined
  put   = undefined
  state = undefined

srStTst' :: StrRdrT (State Int) (Int,Int)
srStTst' = do 
  state $ \s -> ((),s  +  40)   -- no lift!
  m <- get                      -- no lift!
  n <- asksStrRdr length
  put $ m + n                   -- no lift!
  return (m,n)
{-
GHCi> runState (runStrRdrT srStTst' "ABCDE") 2      
((42,5),47)
-}








{-
Чтобы избавится от необходимости ручного подъема операций
\mintinline{text}!askStrRdr! и \mintinline{text}!asksStrRdr!, обеспечивающих стандартный интерфейс вложенного трансформера \mintinline{haskell}!StrRdrT!, 
можно поступить по аналогии с другими трансформерами 
библиотеки \mintinline{text}!mtl!.
А именно, разработать класс типов \mintinline{haskell}!MonadStrRdr!, 
выставляющий этот стандартный интерфейс для нашего ридера:
-}

class Monad m => MonadStrRdr m where
  askSR :: m String
  asksSR :: (String -> a) -> m a
  strRdr :: (String -> a) -> m a

{-
ПРИМЕЧАНИЕ:
(Мы переименовываем функцию \mintinline{text}!askStrRdr! в 
\mintinline{text}!askSR! (и анологично \mintinline{text}!asks!-версию),
поскольку хотим держать всю реализацию в одном файле исходного кода. 
При следовании принятой в библиотеках transformers/mtl идеологии 
они имели бы одно и то же имя,
но были бы определены в разных модулях. При работе с transformers мы 
импортировали бы свободную функцию c квалифицированным именем
\mintinline{text}!Control.Monad.Trans.StrRdr.askStrRdr!, а при использовании 
mtl работали бы с методом класса типов \mintinline{text}!Control.Monad.StrRdr.askStrRdr!.)


Этот интерфейс, во-первых, должен выставлять 
сам трансформер \mintinline{haskell}!StrRdrT!,
обернутый вокруг произвольной монады:
-}

instance Monad m => MonadStrRdr (StrRdrT m) where
  askSR :: StrRdrT m String
  askSR = undefined
  asksSR :: (String -> a) -> StrRdrT m a
  asksSR = undefined
  strRdr :: (String -> a) -> StrRdrT m a
  strRdr = undefined

{-
Реализуйте этого представителя, для проверки используйте
-}
srStTst'' :: StrRdrT (State Int) (Int,Int,Int,String)
srStTst'' = do 
  m <- get
  n <- asksSR length  -- use asksSR
  k <- strRdr length  -- use strRdr
  put $ m + n + k
  e <- askSR          -- use askSR
  return (m,n,k,e)
{-
GHCi> runState (runStrRdrT srStTst'' "ABCDE") 2  
((2,5,5,"ABCDE"),12)
-}
  




{-
Во-вторых, интерфейс MonadLogg должн выставлять любой стандартный трансформер, обернутый вокруг монады,
выставляющий этот интерфейс:
-}
 
instance MonadStrRdr m => MonadStrRdr (StateT s m) where
  askSR :: StateT s m String
  askSR =  undefined
  asksSR :: (String -> a) -> StateT s m a
  asksSR = undefined
  strRdr :: (String -> a) -> StateT s m a
  strRdr = undefined
  
-- WriterT w, etc...


stSrTst' :: StateT Int StrRdr (Int,Int,Int,String)
stSrTst' = do 
  a <- get
  n <- asksSR length   -- no lift!
  k <- strRdr length   -- no lift!
  e <- askSR           -- no lift!
  modify (+n)
  return (a,n,k,e)
{-
GHCi> runStrRdr (runStateT stSrTst' 33) "ABCD"
((33,4,4,"ABCD"),37)
-}







{-
Если трансформер требует операций ввода-вывода, то в качестве его основы используют не
Identity, а IO. Для подъема операций ввода-вывода во внешние трансформеры 
используют специальный класс типов из модуля Control.Monad.IO.Class

class (Monad m) => MonadIO m where
    liftIO :: IO a -> m a

instance MonadIO IO where
    liftIO = id

Сделайте трансформер StrRdrT представителем этого класса типов, если внутренняя монада 
m выставляет этот интерфейс:

-}

instance MonadIO m => MonadIO (StrRdrT m) where
  liftIO = undefined


testSRIO :: StrRdrT IO String    
testSRIO = do
  x <- liftIO getLine
  e <- askSR
  return $ x ++ e

{-
GHCi> runStrRdrT testSRIO " rules!"
Simon Peyton Jones
"Simon Peyton Jones rules!"
GHCi>
-}