git.iko.soy/typeable/pandoc
on master help sign in
Class: no more MonadState CommonState.

- Added getCommonState, putCommonState, getsCommonState, modifyCommonState to PandocMonad interface. - Removed MonadState CommonState instances.

commit54932ade677b48ec42f6461028a3b58bb85aaa50 authorJohn MacFarlane <jgm@berkeley.edu> dateThu 8 Dec 2016, 21:32 (10 years ago) parent40ac0cf
2 files changed+25−16
compare with master
unifiedsplit
src/Text/Pandoc/Class.hs+23−14 tests/Tests/Readers/Txt2Tags.hs+2−2
src/Text/Pandoc/Class.hs+23−14
@@ -98,7 +98,7 @@ import System.IO.Error
9898import qualified Data.Map as M
9999import Text.Pandoc.Error
100100
101−class (Functor m, Applicative m, Monad m, MonadError PandocError m, MonadState CommonState m) => PandocMonad m where
101+class (Functor m, Applicative m, Monad m, MonadError PandocError m) => PandocMonad m where
102102 lookupEnv :: String -> m (Maybe String)
103103 getCurrentTime :: m UTCTime
104104 getCurrentTimeZone :: m TimeZone
@@ -120,32 +120,39 @@ class (Functor m, Applicative m, Monad m, MonadError PandocError m, MonadState C
120120 fail :: String -> m b
121121 glob :: String -> m [FilePath]
122122 getModificationTime :: FilePath -> m UTCTime
123+ getCommonState :: m CommonState
124+ putCommonState :: CommonState -> m ()
123125
126+ getsCommonState :: (CommonState -> a) -> m a
127+ getsCommonState f = f <$> getCommonState
124128
129+ modifyCommonState :: (CommonState -> CommonState) -> m ()
130+ modifyCommonState f = getCommonState >>= putCommonState . f
125131
126132-- Functions defined for all PandocMonad instances
127133
128134warning :: PandocMonad m => String -> m ()
129−warning msg = modify $ \st -> st{stWarnings = msg : stWarnings st}
135+warning msg = modifyCommonState $ \st -> st{stWarnings = msg : stWarnings st}
130136
131137getWarnings :: PandocMonad m => m [String]
132−getWarnings = gets stWarnings
138+getWarnings = getsCommonState stWarnings
133139
134140setMediaBag :: PandocMonad m => MediaBag -> m ()
135−setMediaBag mb = modify $ \st -> st{stMediaBag = mb}
141+setMediaBag mb = modifyCommonState $ \st -> st{stMediaBag = mb}
136142
137143getMediaBag :: PandocMonad m => m MediaBag
138−getMediaBag = gets stMediaBag
144+getMediaBag = getsCommonState stMediaBag
139145
140146insertMedia :: PandocMonad m => FilePath -> Maybe MimeType -> BL.ByteString -> m ()
141147insertMedia fp mime bs =
142− modify $ \st -> st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) }
148+ modifyCommonState $ \st ->
149+ st{stMediaBag = MB.insertMedia fp mime bs (stMediaBag st) }
143150
144151getInputFiles :: PandocMonad m => m (Maybe [FilePath])
145−getInputFiles = gets stInputFiles
152+getInputFiles = getsCommonState stInputFiles
146153
147154getOutputFile :: PandocMonad m => m (Maybe FilePath)
148−getOutputFile = gets stOutputFile
155+getOutputFile = getsCommonState stOutputFile
149156
150157getPOSIXTime :: (PandocMonad m) => m POSIXTime
151158getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime
@@ -164,9 +171,6 @@ warningWithPos pos msg = lift $ warning $ msg ++ " " ++ show pos
164171
165172--
166173
167−-- All PandocMonad instances should be an instance MonadState of this
168−-- datatype:
169−
170174data CommonState = CommonState { stWarnings :: [String]
171175 , stMediaBag :: MediaBag
172176 , stInputFiles :: Maybe [FilePath]
@@ -201,7 +205,6 @@ newtype PandocIO a = PandocIO {
201205 , Functor
202206 , Applicative
203207 , Monad
204− , MonadState CommonState
205208 , MonadError PandocError
206209 )
207210
@@ -233,7 +236,8 @@ instance PandocMonad PandocIO where
233236 case eitherMtime of
234237 Right mtime -> return mtime
235238 Left _ -> throwError $ PandocFileReadError fp
236−
239+ getCommonState = PandocIO $ lift get
240+ putCommonState x = PandocIO $ lift $ put x
237241
238242data PureState = PureState { stStdGen :: StdGen
239243 , stWord8Store :: [Word8] -- should be
@@ -301,7 +305,6 @@ newtype PandocPure a = PandocPure {
301305 } deriving ( Functor
302306 , Applicative
303307 , Monad
304− , MonadState CommonState
305308 , MonadError PandocError
306309 )
307310
@@ -376,6 +379,9 @@ instance PandocMonad PandocPure where
376379 Just tm -> return tm
377380 Nothing -> throwError $ PandocFileReadError fp
378381
382+ getCommonState = PandocPure $ lift $ get
383+ putCommonState x = PandocPure $ lift $ put x
384+
379385instance PandocMonad m => PandocMonad (ParserT s st m) where
380386 lookupEnv = lift . lookupEnv
381387 getCurrentTime = lift getCurrentTime
@@ -391,3 +397,6 @@ instance PandocMonad m => PandocMonad (ParserT s st m) where
391397 fetchItem' media sourceUrl = lift . fetchItem' media sourceUrl
392398 glob = lift . glob
393399 getModificationTime = lift . getModificationTime
400+ getCommonState = lift getCommonState
401+ putCommonState = lift . putCommonState
402+
tests/Tests/Readers/Txt2Tags.hs+2−2
@@ -4,7 +4,6 @@ module Tests.Readers.Txt2Tags (tests) where
44import Text.Pandoc.Definition
55import Test.Framework
66import Tests.Helpers
7−import Control.Monad.State
87import Text.Pandoc.Arbitrary()
98import Text.Pandoc.Builder
109import Text.Pandoc
@@ -15,7 +14,8 @@ import Text.Pandoc.Class
1514t2t :: String -> Pandoc
1615-- t2t = handleError . readTxt2Tags (T2TMeta "date" "mtime" "in" "out") def
1716t2t = purely $ \s -> do
18− put def { stInputFiles = Just ["in"]
17+ putCommonState
18+ def { stInputFiles = Just ["in"]
1919 , stOutputFile = Just "out"
2020 }
2121 readTxt2Tags def s