@@ -0,0 +1,202 @@
1+{-# LANGUAGE DeriveFunctor, DeriveDataTypeable, TypeSynonymInstances, FlexibleInstances #-}
4+Copyright (C) 2016 Jesse Rosenthal <jrosenthal@jhu.edu>
6+This program is free software; you can redistribute it and/or modify
7+it under the terms of the GNU General Public License as published by
8+the Free Software Foundation; either version 2 of the License, or
9+(at your option) any later version.
11+This program is distributed in the hope that it will be useful,
12+but WITHOUT ANY WARRANTY; without even the implied warranty of
13+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14+GNU General Public License for more details.
16+You should have received a copy of the GNU General Public License
17+along with this program; if not, write to the Free Software
18+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22+ Module : Text.Pandoc.Class
23+ Copyright : Copyright (C) 2016 Jesse Rosenthal
24+ License : GNU GPL, version 2 or above
26+ Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
28+ Portability : portable
30+Typeclass for pandoc readers and writers, allowing both IO and pure instances.
33+module Text.Pandoc.Class ( PandocMonad(..)
40+import Prelude hiding (readFile, fail)
41+import qualified Control.Monad as M (fail)
42+import System.Random (StdGen, next)
43+import qualified System.Random as IO (newStdGen)
44+import Codec.Archive.Zip (Archive, fromArchive)
45+import Data.Unique (hashUnique)
46+import qualified Data.Unique as IO (newUnique)
47+import qualified Text.Pandoc.Shared as IO ( fetchItem
49+ , getDefaultReferenceDocx
50+ , getDefaultReferenceODT
53+import Text.Pandoc.MediaBag (MediaBag, lookupMedia)
54+import Text.Pandoc.Compat.Time (UTCTime)
55+import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
56+import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds, POSIXTime )
57+import Text.Pandoc.MIME (MimeType, getMimeType)
58+import qualified Data.ByteString as B
59+import qualified Data.ByteString.Lazy as BL
60+import qualified Control.Exception as E
61+import qualified System.Environment as IO (lookupEnv)
62+import System.FilePath.Glob (match, compile)
63+import System.FilePath ((</>))
64+import qualified System.FilePath.Glob as IO (glob)
65+import Control.Monad.State hiding (fail)
66+import Control.Monad.Reader hiding (fail)
67+import Data.Word (Word8)
70+class Monad m => PandocMonad m where
71+ lookupEnv :: String -> m (Maybe String)
72+ getCurrentTime :: m UTCTime
73+ getDefaultReferenceDocx :: Maybe FilePath -> m Archive
74+ getDefaultReferenceODT :: Maybe FilePath -> m Archive
75+ newStdGen :: m StdGen
76+ newUniqueHash :: m Int
77+ readFileLazy :: FilePath -> m BL.ByteString
78+ readDataFile :: Maybe FilePath -> FilePath -> m B.ByteString
79+ fetchItem :: Maybe String ->
81+ m (Either E.SomeException (B.ByteString, Maybe MimeType))
82+ fetchItem' :: MediaBag ->
85+ m (Either E.SomeException (B.ByteString, Maybe MimeType))
86+ warn :: String -> m ()
87+ fail :: String -> m b
88+ glob :: String -> m [FilePath]
90+--Some functions derived from Primitives:
92+getPOSIXTime :: (PandocMonad m) => m POSIXTime
93+getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime
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
105+ fetchItem = IO.fetchItem
106+ fetchItem' = IO.fetchItem'
112+data TestState = TestState { stStdGen :: StdGen
113+ , stWord8Store :: [Word8] -- should be
116+ , stWarnings :: [String]
117+ , stUniqStore :: [Int] -- should be
124+data TestEnv = TestEnv { envEnv :: [(String, String)]
125+ , envTime :: UTCTime
126+ , envReferenceDocx :: Archive
127+ , envReferenceODT :: Archive
128+ , envFiles :: [(FilePath, B.ByteString)]
129+ , envUserDataDir :: [(FilePath, B.ByteString)]
130+ , envCabalDataDir :: [(FilePath, B.ByteString)]
131+ , envFontFiles :: [FilePath]
134+data TestException = TestException
135+ deriving (Show, Typeable)
137+instance E.Exception TestException
139+type Testing = ReaderT TestEnv (State TestState)
141+instance PandocMonad Testing where
144+ return (lookup s env)
146+ getCurrentTime = asks envTime
148+ getDefaultReferenceDocx _ = asks envReferenceDocx
150+ getDefaultReferenceODT _ = asks envReferenceODT
154+ let (_, nxtGen) = next g
155+ modify $ \st -> st { stStdGen = nxtGen }
159+ uniqs <- gets stUniqStore
162+ modify $ \st -> st { stUniqStore = us }
164+ _ -> M.fail "uniq store ran out of elements"
166+ readFileLazy fp = do
167+ fps <- asks envFiles
168+ case lookup fp fps of
169+ Just bs -> return (BL.fromStrict bs)
170+ Nothing -> error "openFile: does not exist"
172+ readDataFile Nothing "reference.docx" = do
173+ (B.concat . BL.toChunks . fromArchive) <$> (getDefaultReferenceDocx Nothing)
174+ readDataFile Nothing "reference.odt" = do
175+ (B.concat . BL.toChunks . fromArchive) <$> (getDefaultReferenceODT Nothing)
176+ readDataFile Nothing fname = do
177+ let fname' = if fname == "MANUAL.txt" then fname else "data" </> fname
178+ BL.toStrict <$> (readFileLazy fname')
179+ readDataFile (Just userDir) fname = do
180+ userDirFiles <- asks envUserDataDir
181+ case lookup (userDir </> fname) userDirFiles of
182+ Just bs -> return bs
183+ Nothing -> readDataFile Nothing fname
188+ fps <- asks envFiles
189+ case lookup fp fps of
190+ Just bs -> return (Right (bs, getMimeType fp))
191+ Nothing -> return (Left $ E.toException TestException)
193+ fetchItem' media sourceUrl nm = do
194+ case lookupMedia nm media of
195+ Nothing -> fetchItem sourceUrl nm
196+ Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime))
198+ warn s = modify $ \st -> st { stWarnings = s : stWarnings st }
201+ fontFiles <- asks envFontFiles
202+ return (filter (match (compile s)) fontFiles)