New Free module, with pure versions of IO funcs
Introduce a new module, Text.Pandoc.Free, with pure versions, based on the free monad, of numerous IO functions used in writers and readers. These functions are in a pure Monad (PandocAction). PandocAction takes as a parameter the type of IORefs in it. It can be aliased in individual writers and readers to avoid this parameter. Note that this means that at the moment a reader can only use one type of IORef. If possible, it would be nice to remove this limitation.
This commit is contained in:
Jesse Rosenthal
John MacFarlane
parent
a6b469c02b
commit
0ab4af2f03
2 changed files with 211 additions and 1 deletions
|
|
@ -293,7 +293,7 @@ Library
|
|||
filemanip >= 0.3 && < 0.4,
|
||||
cmark >= 0.5 && < 0.6,
|
||||
doctemplates >= 0.1 && < 0.2,
|
||||
ghc-prim >= 0.2
|
||||
free >= 4
|
||||
if flag(old-locale)
|
||||
Build-Depends: old-locale >= 1 && < 1.1,
|
||||
time >= 1.2 && < 1.5
|
||||
|
|
@ -384,6 +384,7 @@ Library
|
|||
Text.Pandoc.SelfContained,
|
||||
Text.Pandoc.Process,
|
||||
Text.Pandoc.CSS
|
||||
Text.Pandoc.Free
|
||||
Other-Modules: Text.Pandoc.Readers.Docx.Lists,
|
||||
Text.Pandoc.Readers.Docx.Combine,
|
||||
Text.Pandoc.Readers.Docx.Parse,
|
||||
|
|
|
|||
209
src/Text/Pandoc/Free.hs
Normal file
209
src/Text/Pandoc/Free.hs
Normal file
|
|
@ -0,0 +1,209 @@
|
|||
{-# LANGUAGE DeriveFunctor #-}
|
||||
|
||||
{-
|
||||
Copyright (C) 2016 Jesse Rosenthal <jrosenthal@jhu.edu>
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
-}
|
||||
|
||||
{- |
|
||||
Module : Text.Pandoc.Free
|
||||
Copyright : Copyright (C) 2016 Jesse Rosenthal
|
||||
License : GNU GPL, version 2 or above
|
||||
|
||||
Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
|
||||
Stability : alpha
|
||||
Portability : portable
|
||||
|
||||
Pure implementations of the IO monads used in Pandoc's readers and writers.
|
||||
-}
|
||||
|
||||
module Text.Pandoc.Free ( PandocActionF(..)
|
||||
, PandocAction
|
||||
, runIO
|
||||
, liftF
|
||||
--
|
||||
, lookupEnv
|
||||
, getCurrentTime
|
||||
, getPOSIXTime
|
||||
, getDefaultReferenceDocx
|
||||
, getDefaultReferenceODT
|
||||
, newStdGen
|
||||
, newUnique
|
||||
, newUUID
|
||||
, readFileStrict
|
||||
, readFileLazy
|
||||
, readFileUTF8
|
||||
, readDataFile
|
||||
, fetchItem
|
||||
, fetchItem'
|
||||
, warn
|
||||
, fail
|
||||
, newIORef
|
||||
, modifyIORef
|
||||
, readIORef
|
||||
, namesMatching
|
||||
) where
|
||||
|
||||
import Prelude hiding (readFile, fail)
|
||||
import qualified Control.Monad as M (fail)
|
||||
import System.Random (StdGen)
|
||||
import qualified System.Random as IO (newStdGen)
|
||||
import Codec.Archive.Zip (Archive)
|
||||
import Data.Unique (Unique)
|
||||
import qualified Data.Unique as IO (newUnique)
|
||||
import qualified Text.Pandoc.Shared as IO ( fetchItem
|
||||
, fetchItem'
|
||||
, getDefaultReferenceDocx
|
||||
, getDefaultReferenceODT
|
||||
, warn
|
||||
, readDataFile)
|
||||
import Text.Pandoc.MediaBag (MediaBag)
|
||||
import Data.Time.Clock.POSIX (POSIXTime)
|
||||
import qualified Data.Time.Clock.POSIX as IO (getPOSIXTime)
|
||||
import Text.Pandoc.Compat.Time (UTCTime)
|
||||
import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
|
||||
import Text.Pandoc.MIME (MimeType)
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Control.Monad.Free
|
||||
import qualified Control.Exception as E
|
||||
import qualified System.Environment as IO (lookupEnv)
|
||||
import Data.IORef (IORef)
|
||||
import qualified Data.IORef as IO (newIORef, modifyIORef, readIORef)
|
||||
import Text.Pandoc.UUID (UUID)
|
||||
import qualified Text.Pandoc.UUID as IO (getRandomUUID)
|
||||
import qualified Text.Pandoc.UTF8 as UTF8 (readFile)
|
||||
import qualified System.FilePath.Glob as IO (namesMatching)
|
||||
|
||||
data PandocActionF ref nxt =
|
||||
LookupEnv String (Maybe String -> nxt)
|
||||
| GetCurrentTime (UTCTime -> nxt)
|
||||
| GetPOSIXTime (POSIXTime -> nxt)
|
||||
| GetDefaultReferenceDocx (Maybe FilePath) (Archive -> nxt)
|
||||
| GetDefaultReferenceODT (Maybe FilePath) (Archive -> nxt)
|
||||
| NewStdGen (StdGen -> nxt)
|
||||
| NewUnique (Unique -> nxt)
|
||||
| NewUUID (UUID -> nxt)
|
||||
| ReadFileStrict FilePath (B.ByteString -> nxt)
|
||||
| ReadFileLazy FilePath (BL.ByteString -> nxt)
|
||||
| ReadFileUTF8 FilePath (String -> nxt)
|
||||
| ReadDataFile (Maybe FilePath) FilePath (B.ByteString -> nxt)
|
||||
| FetchItem (Maybe String) (String)
|
||||
(Either E.SomeException (B.ByteString, Maybe MimeType) -> nxt)
|
||||
| FetchItem' MediaBag (Maybe String) (String)
|
||||
(Either E.SomeException (B.ByteString, Maybe MimeType) -> nxt)
|
||||
| NewIORef ref (IORef ref -> nxt)
|
||||
| ModifyIORef (IORef ref) (ref -> ref) nxt
|
||||
| ReadIORef (IORef ref) (ref -> nxt)
|
||||
| NamesMatching String ([FilePath] -> nxt)
|
||||
| Warn String nxt
|
||||
| Fail String
|
||||
deriving Functor
|
||||
|
||||
type PandocAction a = Free (PandocActionF a)
|
||||
|
||||
lookupEnv :: String -> PandocAction a (Maybe String)
|
||||
lookupEnv s = liftF $ LookupEnv s id
|
||||
|
||||
getCurrentTime :: PandocAction a UTCTime
|
||||
getCurrentTime = liftF $ GetCurrentTime id
|
||||
|
||||
getPOSIXTime :: PandocAction a POSIXTime
|
||||
getPOSIXTime = liftF $ GetPOSIXTime id
|
||||
|
||||
getDefaultReferenceDocx :: Maybe FilePath -> PandocAction a Archive
|
||||
getDefaultReferenceDocx fp = liftF $ GetDefaultReferenceDocx fp id
|
||||
|
||||
getDefaultReferenceODT :: Maybe FilePath -> PandocAction a Archive
|
||||
getDefaultReferenceODT fp = liftF $ GetDefaultReferenceODT fp id
|
||||
|
||||
newStdGen :: PandocAction a StdGen
|
||||
newStdGen = liftF $ NewStdGen id
|
||||
|
||||
newUnique :: PandocAction a Unique
|
||||
newUnique = liftF $ NewUnique id
|
||||
|
||||
newUUID :: PandocAction a UUID
|
||||
newUUID = liftF $ NewUUID id
|
||||
|
||||
readFileStrict :: FilePath -> PandocAction a B.ByteString
|
||||
readFileStrict fp = liftF $ ReadFileStrict fp id
|
||||
|
||||
readFileLazy :: FilePath -> PandocAction a BL.ByteString
|
||||
readFileLazy fp = liftF $ ReadFileLazy fp id
|
||||
|
||||
readFileUTF8 :: FilePath -> PandocAction a String
|
||||
readFileUTF8 fp = liftF $ ReadFileUTF8 fp id
|
||||
|
||||
readDataFile :: Maybe FilePath -> FilePath -> PandocAction a B.ByteString
|
||||
readDataFile mfp fp = liftF $ ReadDataFile mfp fp id
|
||||
|
||||
fetchItem :: Maybe String ->
|
||||
String ->
|
||||
PandocAction a (Either E.SomeException (B.ByteString, Maybe MimeType))
|
||||
fetchItem ms s = liftF $ FetchItem ms s id
|
||||
|
||||
|
||||
fetchItem' :: MediaBag ->
|
||||
Maybe String ->
|
||||
String ->
|
||||
PandocAction a (Either E.SomeException (B.ByteString, Maybe MimeType))
|
||||
fetchItem' mb ms s = liftF $ FetchItem' mb ms s id
|
||||
|
||||
warn :: String -> PandocAction a ()
|
||||
warn s = liftF $ Warn s ()
|
||||
|
||||
fail :: String -> PandocAction a b
|
||||
fail s = liftF $ Fail s
|
||||
|
||||
newIORef :: a -> PandocAction a (IORef a)
|
||||
newIORef v = liftF $ NewIORef v id
|
||||
|
||||
modifyIORef :: (IORef a) -> (a -> a) -> PandocAction a ()
|
||||
modifyIORef ref f = liftF $ ModifyIORef ref f ()
|
||||
|
||||
readIORef :: (IORef a) -> PandocAction a a
|
||||
readIORef ref = liftF $ ReadIORef ref id
|
||||
|
||||
namesMatching :: String -> PandocAction a [FilePath]
|
||||
namesMatching s = liftF $ NamesMatching s id
|
||||
|
||||
runIO :: PandocAction ref nxt -> IO nxt
|
||||
runIO (Free (LookupEnv s f)) = IO.lookupEnv s >>= runIO . f
|
||||
runIO (Free (GetCurrentTime f)) = IO.getCurrentTime >>= runIO . f
|
||||
runIO (Free (GetPOSIXTime f)) = IO.getPOSIXTime >>= runIO . f
|
||||
runIO (Free (GetDefaultReferenceDocx mfp f)) =
|
||||
IO.getDefaultReferenceDocx mfp >>= runIO . f
|
||||
runIO (Free (GetDefaultReferenceODT mfp f)) =
|
||||
IO.getDefaultReferenceODT mfp >>= runIO . f
|
||||
runIO (Free (NewStdGen f)) = IO.newStdGen >>= runIO . f
|
||||
runIO (Free (NewUnique f)) = IO.newUnique >>= runIO . f
|
||||
runIO (Free (NewUUID f)) = IO.getRandomUUID >>= runIO . f
|
||||
runIO (Free (ReadFileStrict fp f)) = B.readFile fp >>= runIO . f
|
||||
runIO (Free (ReadFileLazy fp f)) = BL.readFile fp >>= runIO . f
|
||||
runIO (Free (ReadFileUTF8 fp f)) = UTF8.readFile fp >>= runIO . f
|
||||
runIO (Free (ReadDataFile mfp fp f)) = IO.readDataFile mfp fp >>= runIO . f
|
||||
runIO (Free (Fail s)) = M.fail s
|
||||
runIO (Free (FetchItem sourceUrl nm f)) =
|
||||
IO.fetchItem sourceUrl nm >>= runIO . f
|
||||
runIO (Free (FetchItem' media sourceUrl nm f)) =
|
||||
IO.fetchItem' media sourceUrl nm >>= runIO . f
|
||||
runIO (Free (Warn s nxt)) = IO.warn s >> runIO nxt
|
||||
runIO (Free (NewIORef v f)) = IO.newIORef v >>= runIO . f
|
||||
runIO (Free (ModifyIORef ref f nxt)) = IO.modifyIORef ref f >> runIO nxt
|
||||
runIO (Free (ReadIORef ref f)) = IO.readIORef ref >>= runIO . f
|
||||
runIO (Free (NamesMatching s f)) = IO.namesMatching s >>= runIO . f
|
||||
runIO (Pure r) = return r
|
||||
Loading…
Add table
Reference in a new issue