Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit2c9017e

Browse files
committed
works more generally
1 parent604e6cb commit2c9017e

File tree

3 files changed

+56
-41
lines changed

3 files changed

+56
-41
lines changed

‎rhine/rhine.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -160,6 +160,7 @@ test-suite test
160160
rhine,
161161
tasty ^>=1.4,
162162
tasty-hunit ^>=0.10,
163+
mtl,
163164

164165
flagdev
165166
description: Enable warnings as errors. Active on ci.

‎rhine/src/FRP/Rhine/Clock/Except.hs

Lines changed: 36 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ module FRP.Rhine.Clock.Except where
44

55
importControl.Exception
66
importControl.ExceptionqualifiedasException
7-
importControl.Monad ((<=<))
7+
importControl.Monad ((<=<),(>=>))
88
importControl.Monad.Error.Class
99
importControl.Monad.IO.Class (MonadIO,liftIO)
1010
importControl.Monad.Trans.Class (lift)
@@ -33,29 +33,25 @@ instance (Exception e, Clock IO cl, MonadIO eio, MonadError e eio) => Clock eio
3333

3434
instanceGetClockProxy (ExceptClockcle)
3535

36-
dataCatchClockclecl'e'=CatchClockcl (e->Eithere'cl')
36+
dataCatchClockclecl'=CatchClockcl (e->cl')
3737

38-
instance (Timecl~Timecl',Clock (ExceptTem)cl,Clock(ExceptTe'm)cl',Monadm)=>Clock(ExceptTe'm) (CatchClockclecl'e')where
39-
typeTime (CatchClockclecl'e')=Timecl
40-
typeTag (CatchClockclecl'e')=Either (Tagcl) (Tagcl')
38+
instance (Timecl~Timecl',Clock (ExceptTem)cl,Clockmcl',Monadm)=>Clockm (CatchClockclecl')where
39+
typeTime (CatchClockclecl')=Timecl
40+
typeTag (CatchClockclecl')=Either (Tagcl) (Tagcl')
4141
initClock (CatchClock cl handler)=do
42-
tryToInit<-lift$runExceptT$ first (>>> arr (secondLeft))<$> initClock cl
42+
tryToInit<- runExceptT$ first (>>> arr (secondLeft))<$> initClock cl
4343
-- FIXME Each of these branches needs a unit test
4444
case tryToInitof
4545
Right (runningClock, initTime)->do
46-
let catchingClock=runMSFExcept$do
46+
let catchingClock=safely$do
4747
e<-MSFExcept.try runningClock
48-
case handler eof
49-
Right cl'->do
50-
tryToInit'<- once_$ runExceptT$ initClock cl'
51-
case tryToInit'of
52-
Right (runningClock', _)->MSFExcept.try$ runningClock'>>> arr (secondRight)
53-
Left e'->return e'
54-
Left e'->return e'
48+
let cl'= handler e
49+
(runningClock', _)<- once_$ initClock cl'
50+
safe$ runningClock'>>> arr (secondRight)
5551
return (catchingClock, initTime)
56-
Left e->either throwE(fmap (first (>>> arr (secondRight))). initClock)$ handler e
52+
Left e-> (fmap (first (>>> arr (secondRight))). initClock)$ handler e
5753

58-
instance (GetClockProxy (CatchClockclecl'e'))
54+
instance (GetClockProxy (CatchClockclecl'))
5955

6056
typeSafeClockm=HoistClock (ExceptTVoidm)m
6157

@@ -66,39 +62,49 @@ safeClock unhoistedClock =
6662
, monadMorphism=fmap (either absurdid). runExceptT
6763
}
6864

69-
typeCatchSafeclecl'm=SafeClockm (CatchClockcle (LiftClockm (ExceptTVoid)cl')Void)
70-
71-
catchSafe:: (Monadm)=>cl-> (e->cl')->CatchSafeclecl'm
72-
catchSafe cl handler= safeClock$CatchClock cl$Right. liftClock. handler
73-
7465
dataSinglemtimetage=Single
7566
{singleTag::tag
7667
,getTime::mtime
7768
,exception::e
7869
}
7970

80-
instance (TimeDomaintime,Monadm)=>Clock(ExceptTem) (Singlemtimetage)where
71+
instance (TimeDomaintime,MonadErrorem)=>Clockm (Singlemtimetage)where
8172
typeTime (Singlemtimetage)=time
8273
typeTag (Singlemtimetage)=tag
8374
initClockSingle {singleTag, getTime, exception}=do
84-
initTime<-liftgetTime
85-
let runningClock= runMSFExcept$do
75+
initTime<- getTime
76+
let runningClock=morphS (errorT. runExceptT)$runMSFExcept$do
8677
step_ (initTime, singleTag)
8778
return exception
79+
errorT:: (MonadErrorem)=>m (Eitherea)->ma
80+
errorT= (>>= liftEither)
8881
return (runningClock, initTime)
8982

90-
typeDelayExceptionmtimeclee'=CatchClockcle (Singlemtimeee')e'
83+
typeDelayExceptionmtimeclee'=CatchClockcle (Singlemtimeee')
9184

92-
delayException:: (Clock (ExceptTem)cl)=>cl-> (e->e')->m (Timecl)->DelayExceptionm (Timecl)clee'
93-
delayException cl handler mTime=CatchClock cl$Right. (\e->Single e mTime$ handler e)
85+
delayException:: (Monadm,Clock (ExceptTem)cl,MonadErrore'm)=>cl-> (e->e')->m (Timecl)->DelayExceptionm (Timecl)clee'
86+
delayException cl handler mTime=CatchClock cl$\e->Single e mTime$ handler e
9487

95-
delayException':: (Clock (ExceptTem)cl)=>cl->m (Timecl)->DelayExceptionm (Timecl)clee
88+
delayException':: (Monadm,MonadErrorem,Clock (ExceptTem)cl)=>cl->m (Timecl)->DelayExceptionm (Timecl)clee
9689
delayException' cl= delayException clid
9790

98-
typeDelayIOExceptionclee'=DelayExceptionIOUTCTime (ExceptClockcle)ee'
91+
typeDelayMonadIOExceptionmclee'=DelayExceptionmUTCTime (ExceptClockcle)ee'
92+
93+
delayMonadIOException:: (Exceptione,MonadIOm,MonadErrore'm,ClockIOcl,Timecl~UTCTime)=>cl-> (e->e')->DelayMonadIOExceptionmclee'
94+
delayMonadIOException cl handler= delayException (ExceptClock cl) handler$ liftIO getCurrentTime
95+
96+
typeDelayMonadIOErrormcle=DelayMonadIOExceptionmclIOErrore
97+
98+
delayMonadIOError:: (Exceptione,MonadErrorem,MonadIOm,ClockIOcl,Timecl~UTCTime)=>cl-> (IOError->e)->DelayMonadIOErrormcle
99+
delayMonadIOError= delayMonadIOException
100+
101+
delayMonadIOError':: (MonadErrorIOErrorm,MonadIOm,ClockIOcl,Timecl~UTCTime)=>cl->DelayMonadIOErrormclIOError
102+
delayMonadIOError' cl= delayMonadIOError clid
103+
104+
typeDelayIOExceptionclee'=DelayException (ExceptTe'IO)UTCTime (ExceptClockcle)ee'
99105

100106
delayIOException:: (Exceptione,ClockIOcl,Timecl~UTCTime)=>cl-> (e->e')->DelayIOExceptionclee'
101-
delayIOException cl handler= delayException (ExceptClock cl) handler getCurrentTime
107+
delayIOException cl handler= delayException (ExceptClock cl) handler$ liftIOgetCurrentTime
102108

103109
delayIOException':: (Exceptione,ClockIOcl,Timecl~UTCTime)=>cl->DelayIOExceptionclee
104110
delayIOException' cl= delayIOException clid

‎rhine/test/Clock/Except.hs

Lines changed: 19 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -9,9 +9,12 @@ import GHC.IO.Handle (hDuplicateTo)
99
importSystem.IO (IOMode (ReadMode),stdin,withFile)
1010
importSystem.IO.Error (isEOFError)
1111

12+
-- mtl
13+
importControl.Monad.Writer.Class
14+
1215
-- transformers
13-
importControl.Monad.Trans.Class
14-
importControl.Monad.Trans.Writer.CPS
16+
-- Replace Strict by CPS when bumping mtl to 2.3
17+
importControl.Monad.Trans.Writer.Stricthiding (tell)
1518

1619
-- text
1720
importData.Text (Text)
@@ -24,7 +27,7 @@ import Test.Tasty.HUnit (testCase, (@?), (@?=))
2427

2528
-- rhine
2629
importFRP.Rhine
27-
importFRP.Rhine.Clock.Except (CatchClock (CatchClock),DelayIOError,ExceptClock (ExceptClock),delayIOError,delayIOError')
30+
importFRP.Rhine.Clock.Except (CatchClock (CatchClock),DelayIOError,DelayMonadIOError,ExceptClock (ExceptClock),delayIOError,delayMonadIOError')
2831
importPaths_rhine
2932

3033
-- FIXME organisation: group functions & clock values closer to their test cases
@@ -41,12 +44,11 @@ type TestClock =
4144
EClock
4245
IOError
4346
EClock
44-
IOError
4547
)
4648

4749
-- FIXME also need to test the other branch of CatchClock
4850
testClock::TestClock
49-
testClock= liftClock$CatchClock (ExceptClockStdinClock)$const$Right$ExceptClockStdinClock
51+
testClock= liftClock$CatchClock (ExceptClockStdinClock)$const$ExceptClockStdinClock
5052

5153
clsf::ClSFMTestClock()()
5254
clsf=proc()->do
@@ -73,10 +75,12 @@ clsf3 = proc () -> do
7375
_textSoFar<- mappendS-<eitherpure (const[]) tag
7476
returnA-<()
7577

76-
clsf4::ClSF (ExceptTIOError (WriterT [Text]IO)) (LiftClock (WriterT [Text]IO) (ExceptTIOError) (DelayIOErrorStdinClockIOError))()()
77-
clsf4= tagS>>>proc tag->case tagof
78-
Left text-> arrMCl (lift. tell)-< [text]
79-
Right _-> returnA-<()
78+
-- clsf4 :: ClSF (ExceptT IOError (WriterT [Text] IO)) (LiftClock (WriterT [Text] IO) (ExceptT IOError) (DelayIOError StdinClock IOError)) () ()
79+
clsf4:: (Tagcl~EitherTexta)=> (MonadWriter [Text]m)=>ClSFmcl()()
80+
clsf4=
81+
tagS>>>proc tag->case tagof
82+
Left text-> arrMCl tell-< [text]
83+
Right _-> returnA-<()
8084

8185
tests=
8286
testGroup
@@ -91,10 +95,14 @@ tests =
9195
result<- runExceptT$ flow$ clsf3@@ delayedClock
9296
result@?=LeftNothing
9397
, testCase"DelayException throws error after 1 step, but can write down results"$ withTestStdin$do
94-
result<- runWriterT$ runExceptT$ flow$ clsf4@@ liftClock (delayIOError'StdinClock)
95-
result@?= (Left _, ["hi"])
98+
(Left e, result)<- runWriterT$ runExceptT$ flow$ clsf4@@ clWriterExcept
99+
isEOFError e@?"is EOF"
100+
result@?= ["test","data"]
96101
]
97102

103+
clWriterExcept::DelayMonadIOError (ExceptTIOError (WriterT [Text]IO))StdinClockIOError
104+
clWriterExcept= delayMonadIOError'StdinClock
105+
98106
withTestStdin::IOa->IOa
99107
withTestStdin action=do
100108
testdataFile<- getDataFileName"test/assets/testdata.txt"

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp