@@ -0,0 +1,209 @@
1+{-# LANGUAGE DeriveFunctor #-}
2+
3+{-
4+Copyright (C) 2016 Jesse Rosenthal <jrosenthal@jhu.edu>
5+
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.
10+
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.
15+
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
19+-}
20+
21+{- |
22+ Module : Text.Pandoc.Free
23+ Copyright : Copyright (C) 2016 Jesse Rosenthal
24+ License : GNU GPL, version 2 or above
25+
26+ Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
27+ Stability : alpha
28+ Portability : portable
29+
30+Pure implementations of the IO monads used in Pandoc's readers and writers.
31+-}
32+
33+module Text.Pandoc.Free ( PandocActionF(..)
34+ , PandocAction
35+ , runIO
36+ , liftF
37+ --
38+ , lookupEnv
39+ , getCurrentTime
40+ , getPOSIXTime
41+ , getDefaultReferenceDocx
42+ , getDefaultReferenceODT
43+ , newStdGen
44+ , newUnique
45+ , newUUID
46+ , readFileStrict
47+ , readFileLazy
48+ , readFileUTF8
49+ , readDataFile
50+ , fetchItem
51+ , fetchItem'
52+ , warn
53+ , fail
54+ , newIORef
55+ , modifyIORef
56+ , readIORef
57+ , namesMatching
58+ ) where
59+
60+import Prelude hiding (readFile, fail)
61+import qualified Control.Monad as M (fail)
62+import System.Random (StdGen)
63+import qualified System.Random as IO (newStdGen)
64+import Codec.Archive.Zip (Archive)
65+import Data.Unique (Unique)
66+import qualified Data.Unique as IO (newUnique)
67+import qualified Text.Pandoc.Shared as IO ( fetchItem
68+ , fetchItem'
69+ , getDefaultReferenceDocx
70+ , getDefaultReferenceODT
71+ , warn
72+ , readDataFile)
73+import Text.Pandoc.MediaBag (MediaBag)
74+import Data.Time.Clock.POSIX (POSIXTime)
75+import qualified Data.Time.Clock.POSIX as IO (getPOSIXTime)
76+import Text.Pandoc.Compat.Time (UTCTime)
77+import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)
78+import Text.Pandoc.MIME (MimeType)
79+import qualified Data.ByteString as B
80+import qualified Data.ByteString.Lazy as BL
81+import Control.Monad.Free
82+import qualified Control.Exception as E
83+import qualified System.Environment as IO (lookupEnv)
84+import Data.IORef (IORef)
85+import qualified Data.IORef as IO (newIORef, modifyIORef, readIORef)
86+import Text.Pandoc.UUID (UUID)
87+import qualified Text.Pandoc.UUID as IO (getRandomUUID)
88+import qualified Text.Pandoc.UTF8 as UTF8 (readFile)
89+import qualified System.FilePath.Glob as IO (namesMatching)
90+
91+data PandocActionF ref nxt =
92+ LookupEnv String (Maybe String -> nxt)
93+ | GetCurrentTime (UTCTime -> nxt)
94+ | GetPOSIXTime (POSIXTime -> nxt)
95+ | GetDefaultReferenceDocx (Maybe FilePath) (Archive -> nxt)
96+ | GetDefaultReferenceODT (Maybe FilePath) (Archive -> nxt)
97+ | NewStdGen (StdGen -> nxt)
98+ | NewUnique (Unique -> nxt)
99+ | NewUUID (UUID -> nxt)
100+ | ReadFileStrict FilePath (B.ByteString -> nxt)
101+ | ReadFileLazy FilePath (BL.ByteString -> nxt)
102+ | ReadFileUTF8 FilePath (String -> nxt)
103+ | ReadDataFile (Maybe FilePath) FilePath (B.ByteString -> nxt)
104+ | FetchItem (Maybe String) (String)
105+ (Either E.SomeException (B.ByteString, Maybe MimeType) -> nxt)
106+ | FetchItem' MediaBag (Maybe String) (String)
107+ (Either E.SomeException (B.ByteString, Maybe MimeType) -> nxt)
108+ | NewIORef ref (IORef ref -> nxt)
109+ | ModifyIORef (IORef ref) (ref -> ref) nxt
110+ | ReadIORef (IORef ref) (ref -> nxt)
111+ | NamesMatching String ([FilePath] -> nxt)
112+ | Warn String nxt
113+ | Fail String
114+ deriving Functor
115+
116+type PandocAction a = Free (PandocActionF a)
117+
118+lookupEnv :: String -> PandocAction a (Maybe String)
119+lookupEnv s = liftF $ LookupEnv s id
120+
121+getCurrentTime :: PandocAction a UTCTime
122+getCurrentTime = liftF $ GetCurrentTime id
123+
124+getPOSIXTime :: PandocAction a POSIXTime
125+getPOSIXTime = liftF $ GetPOSIXTime id
126+
127+getDefaultReferenceDocx :: Maybe FilePath -> PandocAction a Archive
128+getDefaultReferenceDocx fp = liftF $ GetDefaultReferenceDocx fp id
129+
130+getDefaultReferenceODT :: Maybe FilePath -> PandocAction a Archive
131+getDefaultReferenceODT fp = liftF $ GetDefaultReferenceODT fp id
132+
133+newStdGen :: PandocAction a StdGen
134+newStdGen = liftF $ NewStdGen id
135+
136+newUnique :: PandocAction a Unique
137+newUnique = liftF $ NewUnique id
138+
139+newUUID :: PandocAction a UUID
140+newUUID = liftF $ NewUUID id
141+
142+readFileStrict :: FilePath -> PandocAction a B.ByteString
143+readFileStrict fp = liftF $ ReadFileStrict fp id
144+
145+readFileLazy :: FilePath -> PandocAction a BL.ByteString
146+readFileLazy fp = liftF $ ReadFileLazy fp id
147+
148+readFileUTF8 :: FilePath -> PandocAction a String
149+readFileUTF8 fp = liftF $ ReadFileUTF8 fp id
150+
151+readDataFile :: Maybe FilePath -> FilePath -> PandocAction a B.ByteString
152+readDataFile mfp fp = liftF $ ReadDataFile mfp fp id
153+
154+fetchItem :: Maybe String ->
155+ String ->
156+ PandocAction a (Either E.SomeException (B.ByteString, Maybe MimeType))
157+fetchItem ms s = liftF $ FetchItem ms s id
158+
159+
160+fetchItem' :: MediaBag ->
161+ Maybe String ->
162+ String ->
163+ PandocAction a (Either E.SomeException (B.ByteString, Maybe MimeType))
164+fetchItem' mb ms s = liftF $ FetchItem' mb ms s id
165+
166+warn :: String -> PandocAction a ()
167+warn s = liftF $ Warn s ()
168+
169+fail :: String -> PandocAction a b
170+fail s = liftF $ Fail s
171+
172+newIORef :: a -> PandocAction a (IORef a)
173+newIORef v = liftF $ NewIORef v id
174+
175+modifyIORef :: (IORef a) -> (a -> a) -> PandocAction a ()
176+modifyIORef ref f = liftF $ ModifyIORef ref f ()
177+
178+readIORef :: (IORef a) -> PandocAction a a
179+readIORef ref = liftF $ ReadIORef ref id
180+
181+namesMatching :: String -> PandocAction a [FilePath]
182+namesMatching s = liftF $ NamesMatching s id
183+
184+runIO :: PandocAction ref nxt -> IO nxt
185+runIO (Free (LookupEnv s f)) = IO.lookupEnv s >>= runIO . f
186+runIO (Free (GetCurrentTime f)) = IO.getCurrentTime >>= runIO . f
187+runIO (Free (GetPOSIXTime f)) = IO.getPOSIXTime >>= runIO . f
188+runIO (Free (GetDefaultReferenceDocx mfp f)) =
189+ IO.getDefaultReferenceDocx mfp >>= runIO . f
190+runIO (Free (GetDefaultReferenceODT mfp f)) =
191+ IO.getDefaultReferenceODT mfp >>= runIO . f
192+runIO (Free (NewStdGen f)) = IO.newStdGen >>= runIO . f
193+runIO (Free (NewUnique f)) = IO.newUnique >>= runIO . f
194+runIO (Free (NewUUID f)) = IO.getRandomUUID >>= runIO . f
195+runIO (Free (ReadFileStrict fp f)) = B.readFile fp >>= runIO . f
196+runIO (Free (ReadFileLazy fp f)) = BL.readFile fp >>= runIO . f
197+runIO (Free (ReadFileUTF8 fp f)) = UTF8.readFile fp >>= runIO . f
198+runIO (Free (ReadDataFile mfp fp f)) = IO.readDataFile mfp fp >>= runIO . f
199+runIO (Free (Fail s)) = M.fail s
200+runIO (Free (FetchItem sourceUrl nm f)) =
201+ IO.fetchItem sourceUrl nm >>= runIO . f
202+runIO (Free (FetchItem' media sourceUrl nm f)) =
203+ IO.fetchItem' media sourceUrl nm >>= runIO . f
204+runIO (Free (Warn s nxt)) = IO.warn s >> runIO nxt
205+runIO (Free (NewIORef v f)) = IO.newIORef v >>= runIO . f
206+runIO (Free (ModifyIORef ref f nxt)) = IO.modifyIORef ref f >> runIO nxt
207+runIO (Free (ReadIORef ref f)) = IO.readIORef ref >>= runIO . f
208+runIO (Free (NamesMatching s f)) = IO.namesMatching s >>= runIO . f
209+runIO (Pure r) = return r