From 65953181423559c20a79ef1407843143991f3a46 Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Mon, 21 Nov 2016 10:13:14 -0500 Subject: Remove Text.Pandoc.Free --- src/Text/Pandoc/Free.hs | 269 ------------------------------------------------ 1 file changed, 269 deletions(-) delete mode 100644 src/Text/Pandoc/Free.hs (limited to 'src/Text/Pandoc/Free.hs') diff --git a/src/Text/Pandoc/Free.hs b/src/Text/Pandoc/Free.hs deleted file mode 100644 index a1ea45cd6..000000000 --- a/src/Text/Pandoc/Free.hs +++ /dev/null @@ -1,269 +0,0 @@ -{-# LANGUAGE DeriveFunctor, DeriveDataTypeable #-} - -{- -Copyright (C) 2016 Jesse Rosenthal - -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 - Stability : alpha - Portability : portable - -Pure implementations of the IO monads used in Pandoc's readers and writers. --} - -module Text.Pandoc.Free ( PandocActionF(..) - , PandocAction - , runIO - , runTest - , TestState(..) - , TestEnv(..) - , liftF - -- - , lookupEnv - , getCurrentTime - , getPOSIXTime - , getDefaultReferenceDocx - , getDefaultReferenceODT - , newStdGen - , newUniqueHash - , readFileLazy - , readDataFile - , fetchItem - , fetchItem' - , warn - , fail - , glob - ) where - -import Prelude hiding (readFile, fail) -import qualified Control.Monad as M (fail) -import System.Random (StdGen, next) -import qualified System.Random as IO (newStdGen) -import Codec.Archive.Zip (Archive, fromArchive) -import Data.Unique (hashUnique) -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, lookupMedia) -import Text.Pandoc.Compat.Time (UTCTime) -import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime) -import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds, POSIXTime ) -import Text.Pandoc.MIME (MimeType, getMimeType) -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 System.FilePath.Glob (match, compile) -import System.FilePath (()) -import qualified System.FilePath.Glob as IO (glob) -import Control.Monad.State hiding (fail) -import Control.Monad.Reader hiding (fail) -import Data.Word (Word8) -import Data.Typeable - -data PandocActionF nxt = - LookupEnv String (Maybe String -> nxt) - | GetCurrentTime (UTCTime -> nxt) - | GetDefaultReferenceDocx (Maybe FilePath) (Archive -> nxt) - | GetDefaultReferenceODT (Maybe FilePath) (Archive -> nxt) - | NewStdGen (StdGen -> nxt) - | NewUniqueHash (Int -> nxt) - | ReadFileLazy FilePath (BL.ByteString -> 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) - | Glob String ([FilePath] -> nxt) - | Warn String nxt - | Fail String - deriving Functor - -type PandocAction = Free PandocActionF - -lookupEnv :: String -> PandocAction (Maybe String) -lookupEnv s = liftF $ LookupEnv s id - -getCurrentTime :: PandocAction UTCTime -getCurrentTime = liftF $ GetCurrentTime id - -getPOSIXTime :: PandocAction POSIXTime -getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime - -getDefaultReferenceDocx :: Maybe FilePath -> PandocAction Archive -getDefaultReferenceDocx fp = liftF $ GetDefaultReferenceDocx fp id - -getDefaultReferenceODT :: Maybe FilePath -> PandocAction Archive -getDefaultReferenceODT fp = liftF $ GetDefaultReferenceODT fp id - -newStdGen :: PandocAction StdGen -newStdGen = liftF $ NewStdGen id - -newUniqueHash :: PandocAction Int -newUniqueHash = liftF $ NewUniqueHash id - -readFileLazy :: FilePath -> PandocAction BL.ByteString -readFileLazy fp = liftF $ ReadFileLazy fp id - -readDataFile :: Maybe FilePath -> FilePath -> PandocAction B.ByteString -readDataFile mfp fp = liftF $ ReadDataFile mfp fp id - -fetchItem :: Maybe String -> - String -> - PandocAction (Either E.SomeException (B.ByteString, Maybe MimeType)) -fetchItem ms s = liftF $ FetchItem ms s id - - -fetchItem' :: MediaBag -> - Maybe String -> - String -> - PandocAction (Either E.SomeException (B.ByteString, Maybe MimeType)) -fetchItem' mb ms s = liftF $ FetchItem' mb ms s id - -warn :: String -> PandocAction () -warn s = liftF $ Warn s () - -fail :: String -> PandocAction b -fail s = liftF $ Fail s - -glob :: String -> PandocAction [FilePath] -glob s = liftF $ Glob s id - -runIO :: PandocAction nxt -> IO nxt -runIO (Free (LookupEnv s f)) = IO.lookupEnv s >>= runIO . f -runIO (Free (GetCurrentTime f)) = IO.getCurrentTime >>= 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 (NewUniqueHash f)) = hashUnique <$> IO.newUnique >>= runIO . f -runIO (Free (ReadFileLazy fp f)) = BL.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 (Glob s f)) = IO.glob s >>= runIO . f -runIO (Pure r) = return r - -data TestState = TestState { stStdGen :: StdGen - , stWord8Store :: [Word8] -- should be - -- inifinite, - -- i.e. [1..] - , stWarnings :: [String] - , stUniqStore :: [Int] -- should be - -- inifinite and - -- contain every - -- element at most - -- once, e.g. [1..] - } - -data TestEnv = TestEnv { envEnv :: [(String, String)] - , envTime :: UTCTime - , envReferenceDocx :: Archive - , envReferenceODT :: Archive - , envFiles :: [(FilePath, B.ByteString)] - , envUserDataDir :: [(FilePath, B.ByteString)] - , envCabalDataDir :: [(FilePath, B.ByteString)] - , envFontFiles :: [FilePath] - } - -data TestException = TestException - deriving (Show, Typeable) - -instance E.Exception TestException - -type Testing = ReaderT TestEnv (State TestState) - -runTest :: PandocAction nxt -> Testing nxt -runTest (Free (LookupEnv s f)) = do - env <- asks envEnv - return (lookup s env) >>= runTest . f -runTest (Free (GetCurrentTime f)) = - asks envTime >>= runTest . f -runTest (Free (GetDefaultReferenceDocx _ f)) = - asks envReferenceDocx >>= runTest . f -runTest (Free (GetDefaultReferenceODT _ f)) = - asks envReferenceODT >>= runTest . f -runTest (Free (NewStdGen f)) = do - g <- gets stStdGen - let (_, nxtGen) = next g - modify $ \st -> st { stStdGen = nxtGen } - return g >>= runTest . f -runTest (Free (NewUniqueHash f)) = do - uniqs <- gets stUniqStore - case uniqs of - u : us -> do - modify $ \st -> st { stUniqStore = us } - return u >>= runTest . f - _ -> M.fail "uniq store ran out of elements" -runTest (Free (ReadFileLazy fp f)) = do - fps <- asks envFiles - case lookup fp fps of - Just bs -> return (BL.fromStrict bs) >>= runTest . f - Nothing -> error "openFile: does not exist" --- A few different cases of readDataFile to reimplement, for when --- there is no filepath and it falls through to readDefaultDataFile -runTest (Free (ReadDataFile Nothing "reference.docx" f)) = do - (B.concat . BL.toChunks . fromArchive) <$> - (runTest $ getDefaultReferenceDocx Nothing) >>= - runTest . f -runTest (Free (ReadDataFile Nothing "reference.odt" f)) = do - (B.concat . BL.toChunks . fromArchive) <$> - (runTest $ getDefaultReferenceODT Nothing) >>= - runTest . f -runTest (Free (ReadDataFile Nothing fname f)) = do - let fname' = if fname == "MANUAL.txt" then fname else "data" fname - runTest (BL.toStrict <$> readFileLazy fname') >>= runTest . f -runTest (Free (ReadDataFile (Just userDir) fname f)) = do - userDirFiles <- asks envUserDataDir - case lookup (userDir fname) userDirFiles of - Just bs -> return bs >>= runTest . f - Nothing -> runTest (readDataFile Nothing fname) >>= runTest . f -runTest (Free (Fail s)) = M.fail s -runTest (Free (FetchItem _ fp f)) = do - fps <- asks envFiles - case lookup fp fps of - Just bs -> return (Right (bs, getMimeType fp)) >>= runTest . f - Nothing -> return (Left $ E.toException TestException) >>= runTest . f -runTest (Free (FetchItem' media sourceUrl nm f)) = do - case lookupMedia nm media of - Nothing -> runTest (fetchItem sourceUrl nm) >>= runTest . f - Just (mime, bs) -> return (Right (B.concat $ BL.toChunks bs, Just mime)) >>= runTest . f -runTest (Free (Warn s nxt)) = do - modify $ \st -> st { stWarnings = s : stWarnings st } - runTest nxt -runTest (Free (Glob s f)) = do - fontFiles <- asks envFontFiles - return (filter (match (compile s)) fontFiles) >>= runTest . f -runTest (Pure r) = return r - - - -- cgit v1.2.3