blob: 1a6a058eef58dadae67eb9c511e7130659237c2f (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
{-# LANGUAGE OverloadedStrings #-}
module Text.Edifact.Fetcher.Commons where
import Text.Edifact.Fetcher.Configuration
import Text.Edifact.Scaffolder.Commons
import Control.Monad ((>=>))
import Control.Monad.Error.Class (MonadError, catchError)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ReaderT, runReaderT)
import Control.Monad.Trans.Class (lift)
import Data.ByteString (ByteString)
import Data.Char (toLower)
import Data.Text as T (unpack, pack)
import Data.Text.IO as TIO (readFile, writeFile)
import Formatting
import System.Directory (doesFileExist)
import Text.Pandoc as Pandoc hiding (Format,
getOutputFile)
import Text.Parsec (Parsec, runParser)
type Fetcher = ReaderT FetchingEnv PandocIO
runFetcher :: Fetcher () -> FetchingEnv -> IO ()
runFetcher f = Pandoc.runIOorExplode . runReaderT f
getOutputFile :: Format String (a -> String) -> FilePath -> a -> Fetcher FilePath
getOutputFile f d c = do
home <- getSpecificationHome
pure (formatToString (string % "/" % string % "/" % f) home d c)
getUrl :: Format String (a -> String) -> a -> Fetcher String
getUrl f c = do
rev <- getTargetRevision
pure (formatToString ("https://service.unece.org/trade/untdid/" % fRevisionLower % f) rev c)
getSpecificationHome :: Fetcher FilePath
getSpecificationHome = do
home <- getHome
rev <- getTargetRevision
pure (home </> formatToString fRevision rev)
htmlToFile :: String -> (ByteString -> Text) -> FilePath -> Fetcher ()
htmlToFile url decoder outputFile = () <$ tryCacheOrHtml decoder url outputFile
htmlToFileWithParser :: (Monoid a, Monoid u) => String -> (ByteString -> Text) -> FilePath -> Parsec String u a -> Fetcher a
htmlToFileWithParser url decoder outputFile parser = do
specification <- tryCacheOrHtml decoder url outputFile
either (error . show) pure
(runParser parser mempty "" (T.unpack specification))
tryCacheOrHtml :: (ByteString -> Text) -> String -> FilePath -> Fetcher Text
tryCacheOrHtml decoder url path = do
fileExists' <- liftIO $ doesFileExist path
content <- if fileExists'
then liftIO $ TIO.readFile path
else readHtmlFromURL decoder url >>= writePlain def
content <$ liftIO (TIO.writeFile path content)
readHtmlFromURL :: (ByteString -> Text) -> String -> Fetcher Pandoc
readHtmlFromURL decoder = lift . (openURL >=> readHtml def . decoder . fst) . pack
lower :: Format r (String -> r)
lower = mapf (fmap toLower) string
fRevision :: Format r (Revision -> r)
fRevision = mapf getRevision string
fRevisionLower :: Format r (Revision -> r)
fRevisionLower = mapf getRevision lower
fMessageCodeLower :: Format r (MessageCode -> r)
fMessageCodeLower = mapf getMessageCode lower
fSegmentCodeLower :: Format r (SegmentCode -> r)
fSegmentCodeLower = mapf getSegmentCode lower
fCompositeCodeLower :: Format r (CompositeCode -> r)
fCompositeCodeLower = mapf getCompositeCode lower
fSimpleCodeLower :: Format r (SimpleCode -> r)
fSimpleCodeLower = mapf getSimpleCode lower
retry :: (MonadIO m, MonadError b m) => Int -> m a -> m a
retry n f | n > 1 = f `catchError` const (say "Retrying" >> retry (n-1) f)
| otherwise = f
|
