git.iko.soy/typeable/pandoc
on master help sign in
Make opaque typeclasses PandocPure and PandocIO
a94f3ddJesse Rosenthal
src/Text/Pandoc/Class.hs+75−33
compare with master
unifiedsplit
@@ -1,4 +1,5 @@
1−{-# LANGUAGE DeriveFunctor, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}
1+{-# LANGUAGE DeriveFunctor, DeriveDataTypeable, TypeSynonymInstances,
2+FlexibleInstances, GeneralizedNewtypeDeriving, FlexibleContexts #-}
2
3
3{-
4{-
4Copyright (C) 2016 Jesse Rosenthal <jrosenthal@jhu.edu>
5Copyright (C) 2016 Jesse Rosenthal <jrosenthal@jhu.edu>
@@ -31,10 +32,14 @@ Typeclass for pandoc readers and writers, allowing both IO and pure instances.
31-}
32-}
32
33
33module Text.Pandoc.Class ( PandocMonad(..)
34module Text.Pandoc.Class ( PandocMonad(..)
34− , Testing
35 , TestState(..)
35 , TestState(..)
36 , TestEnv(..)
36 , TestEnv(..)
37 , getPOSIXTime
37 , getPOSIXTime
38+ , PandocIO(..)
39+ , PandocPure(..)
40+ , PandocExecutionError(..)
41+ , runIO
42+ , runIOorExplode
38 ) where
43 ) where
39
44
40import Prelude hiding (readFile, fail)
45import Prelude hiding (readFile, fail)
@@ -64,10 +69,13 @@ import System.FilePath ((</>))
64import qualified System.FilePath.Glob as IO (glob)
69import qualified System.FilePath.Glob as IO (glob)
65import Control.Monad.State hiding (fail)
70import Control.Monad.State hiding (fail)
66import Control.Monad.Reader hiding (fail)
71import Control.Monad.Reader hiding (fail)
72+import Control.Monad.Except hiding (fail)
67import Data.Word (Word8)
73import Data.Word (Word8)
68import Data.Typeable
74import Data.Typeable
75+import Data.Default
76+import System.IO.Error
69
77
70−class (Functor m, Applicative m, Monad m) => PandocMonad m where
78+class (Functor m, Applicative m, Monad m, MonadError PandocExecutionError m) => PandocMonad m where
71 lookupEnv :: String -> m (Maybe String)
79 lookupEnv :: String -> m (Maybe String)
72 getCurrentTime :: m UTCTime
80 getCurrentTime :: m UTCTime
73 getDefaultReferenceDocx :: Maybe FilePath -> m Archive
81 getDefaultReferenceDocx :: Maybe FilePath -> m Archive
@@ -75,14 +83,16 @@ class (Functor m, Applicative m, Monad m) => PandocMonad m where
75 newStdGen :: m StdGen
83 newStdGen :: m StdGen
76 newUniqueHash :: m Int
84 newUniqueHash :: m Int
77 readFileLazy :: FilePath -> m BL.ByteString
85 readFileLazy :: FilePath -> m BL.ByteString
78− readDataFile :: Maybe FilePath -> FilePath -> m B.ByteString
86+ readDataFile :: Maybe FilePath
87+ -> FilePath
88+ -> m B.ByteString
79− fetchItem :: Maybe String ->
89+ fetchItem :: Maybe String
80− String ->
90+ -> String
81− m (Either E.SomeException (B.ByteString, Maybe MimeType))
91+ -> m (Either E.SomeException (B.ByteString, Maybe MimeType))
82− fetchItem' :: MediaBag ->
92+ fetchItem' :: MediaBag
83− Maybe String ->
93+ -> Maybe String
84− String ->
94+ -> String
85− m (Either E.SomeException (B.ByteString, Maybe MimeType))
95+ -> m (Either E.SomeException (B.ByteString, Maybe MimeType))
86 warn :: String -> m ()
96 warn :: String -> m ()
87 fail :: String -> m b
97 fail :: String -> m b
88 glob :: String -> m [FilePath]
98 glob :: String -> m [FilePath]
@@ -92,22 +102,55 @@ class (Functor m, Applicative m, Monad m) => PandocMonad m where
92getPOSIXTime :: (PandocMonad m) => m POSIXTime
102getPOSIXTime :: (PandocMonad m) => m POSIXTime
93getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime
103getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime
94
104
95−instance PandocMonad IO where
96− lookupEnv = IO.lookupEnv
97− getCurrentTime = IO.getCurrentTime
98− getDefaultReferenceDocx = IO.getDefaultReferenceDocx
99− getDefaultReferenceODT = IO.getDefaultReferenceODT
100− newStdGen = IO.newStdGen
101− newUniqueHash = hashUnique <$> IO.newUnique
102− readFileLazy = BL.readFile
103− readDataFile = IO.readDataFile
104− fail = M.fail
105− fetchItem = IO.fetchItem
106− fetchItem' = IO.fetchItem'
107− warn = IO.warn
108− glob = IO.glob
109−
110
105
106+-- We can add to this as we go
107+data PandocExecutionError = PandocFileReadError String
108+ deriving Show
109+
110+-- Nothing in this for now, but let's put it there anyway.
111+data PandocStateIO = PandocStateIO
112+ deriving Show
113+
114+instance Default PandocStateIO where
115+ def = PandocStateIO
116+
117+runIO :: PandocIO a -> IO (Either PandocExecutionError a)
118+runIO ma = flip evalStateT def $ runExceptT $ unPandocIO ma
119+
120+runIOorExplode :: PandocIO a -> IO a
121+runIOorExplode ma = do
122+ eitherVal <- runIO ma
123+ case eitherVal of
124+ Right x -> return x
125+ Left (PandocFileReadError s) -> error s
126+
127+newtype PandocIO a = PandocIO {
128+ unPandocIO :: ExceptT PandocExecutionError (StateT PandocStateIO IO) a
129+ } deriving (MonadIO, Functor, Applicative, Monad, MonadError PandocExecutionError)
130+
131+instance PandocMonad PandocIO where
132+ lookupEnv = liftIO . IO.lookupEnv
133+ getCurrentTime = liftIO IO.getCurrentTime
134+ getDefaultReferenceDocx = liftIO . IO.getDefaultReferenceDocx
135+ getDefaultReferenceODT = liftIO . IO.getDefaultReferenceODT
136+ newStdGen = liftIO IO.newStdGen
137+ newUniqueHash = hashUnique <$> (liftIO IO.newUnique)
138+ readFileLazy s = do
139+ eitherBS <- liftIO (tryIOError $ BL.readFile s)
140+ case eitherBS of
141+ Right bs -> return bs
142+ Left _ -> throwError $ PandocFileReadError $ "file not found: " ++ s
143+ -- TODO: Make this more sensitive to the different sorts of failure
144+ readDataFile mfp fname = do
145+ eitherBS <- liftIO (tryIOError $ IO.readDataFile mfp fname)
146+ case eitherBS of
147+ Right bs -> return bs
148+ Left _ -> throwError $ PandocFileReadError $ "file not found: " ++ fname
149+ fail = M.fail
150+ fetchItem ms s = liftIO $ IO.fetchItem ms s
151+ fetchItem' mb ms s = liftIO $ IO.fetchItem' mb ms s
152+ warn = liftIO . IO.warn
153+ glob = liftIO . IO.glob
111
154
112data TestState = TestState { stStdGen :: StdGen
155data TestState = TestState { stStdGen :: StdGen
113 , stWord8Store :: [Word8] -- should be
156 , stWord8Store :: [Word8] -- should be
@@ -136,9 +179,12 @@ data TestException = TestException
136
179
137instance E.Exception TestException
180instance E.Exception TestException
138
181
182+newtype PandocPure a = PandocPure {
183+ unPandocPure :: ExceptT PandocExecutionError
139−type Testing = ReaderT TestEnv (State TestState)
184+ (ReaderT TestEnv (State TestState)) a
185+ } deriving (Functor, Applicative, Monad, MonadReader TestEnv, MonadState TestState, MonadError PandocExecutionError)
140
186
141−instance PandocMonad Testing where
187+instance PandocMonad PandocPure where
142 lookupEnv s = do
188 lookupEnv s = do
143 env <- asks envEnv
189 env <- asks envEnv
144 return (lookup s env)
190 return (lookup s env)
@@ -162,13 +208,11 @@ instance PandocMonad Testing where
162 modify $ \st -> st { stUniqStore = us }
208 modify $ \st -> st { stUniqStore = us }
163 return u
209 return u
164 _ -> M.fail "uniq store ran out of elements"
210 _ -> M.fail "uniq store ran out of elements"
165−
166 readFileLazy fp = do
211 readFileLazy fp = do
167 fps <- asks envFiles
212 fps <- asks envFiles
168 case lookup fp fps of
213 case lookup fp fps of
169 Just bs -> return (BL.fromStrict bs)
214 Just bs -> return (BL.fromStrict bs)
170− Nothing -> error "openFile: does not exist"
215+ Nothing -> throwError $ PandocFileReadError "file not in state"
171−
172 readDataFile Nothing "reference.docx" = do
216 readDataFile Nothing "reference.docx" = do
173 (B.concat . BL.toChunks . fromArchive) <$> (getDefaultReferenceDocx Nothing)
217 (B.concat . BL.toChunks . fromArchive) <$> (getDefaultReferenceDocx Nothing)
174 readDataFile Nothing "reference.odt" = do
218 readDataFile Nothing "reference.odt" = do
@@ -181,9 +225,7 @@ instance PandocMonad Testing where
181 case lookup (userDir </> fname) userDirFiles of
225 case lookup (userDir </> fname) userDirFiles of
182 Just bs -> return bs
226 Just bs -> return bs
183 Nothing -> readDataFile Nothing fname
227 Nothing -> readDataFile Nothing fname
184−
185 fail = M.fail
228 fail = M.fail
186−
187 fetchItem _ fp = do
229 fetchItem _ fp = do
188 fps <- asks envFiles
230 fps <- asks envFiles
189 case lookup fp fps of
231 case lookup fp fps of