Remove Text.Pandoc.Free

1 files changed, 0 insertions, 269 deletions

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 <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
-                        , 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
-
-
-