source: adblock2privoxy/adblock2privoxy/src/SourceInfo.hs @ e2b555c

Last change on this file since e2b555c was e2b555c, checked in by Alexey Zubritskiy <a.zubritskiy@…>, 4 years ago

Adapted to GHC 7.10, introduced stack build

  • Property mode set to 100644
File size: 4.1 KB
Line 
1module SourceInfo
2(
3SourceInfo(_url),
4showInfo,
5updateInfo,
6makeInfo,
7readLogInfos,
8infoExpired
9) where
10import InputParser
11import Control.Monad.State
12import Control.Applicative hiding (many)
13import Text.ParserCombinators.Parsec hiding ((<|>),State,Line)
14import Data.Time.Clock
15import Data.Time.Calendar
16--import System.Locale
17import Data.Time.Format
18import Data.Maybe (catMaybes)
19import Data.String.Utils (split)
20
21
22data SourceInfo = SourceInfo { _title, _url, _license, _homepage :: String,
23                               _lastUpdated :: UTCTime, _expires, _version :: Integer, _expired :: Bool }
24
25emptySourceInfo :: SourceInfo
26emptySourceInfo = SourceInfo "" "" "" "" (UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0) ) 72 0 True
27
28separator :: String
29separator = "----- source -----"
30
31endMark :: String
32endMark = "------- end ------"
33
34showInfo :: [SourceInfo] -> [String]
35showInfo sourceInfos = (sourceInfos >>= showInfoItem) ++ [endMark ++ "\n"]
36
37showInfoItem :: SourceInfo -> [String]
38showInfoItem sourceInfo@(SourceInfo _ url _ _ lastUpdated expires _ expired) =
39        catMaybes [ Just separator,
40                    optionalLine "Title: " _title,
41                    Just $ "Url: " ++ url,
42                    Just $ "Last modified: " ++ formatTime defaultTimeLocale "%d %b %Y %H:%M %Z" lastUpdated,
43                    Just $ concat ["Expires: ", show expires, " hours", expiredMark],
44                    optionalLine "Version: " $ show . _version,
45                    optionalLine "License: " _license,
46                    optionalLine "Homepage: " _homepage ]
47    where
48    expiredMark | expired = " (expired)"
49                | otherwise = ""
50    optionalLine caption getter | getter sourceInfo == getter emptySourceInfo = Nothing
51                                | otherwise = Just $ caption ++ getter sourceInfo
52
53updateInfo :: UTCTime -> [Line] -> SourceInfo -> SourceInfo
54updateInfo now lns old
55    = updated { _expired = infoExpired now updated }
56    where
57    initial = old { _lastUpdated = now }
58    updated = execState (sequence $ parseInfo . lineComment <$> take 50 lns) initial
59
60makeInfo :: String -> SourceInfo
61makeInfo url = emptySourceInfo { _url = url }
62
63readLogInfos :: [String] -> [SourceInfo]
64readLogInfos lns = chunkInfo <$> chunks
65   where
66   chunks = filter (not.null) . split [separator] . takeWhile (/= endMark) $ lns
67   chunkInfo chunk = execState (sequence $ parseInfo <$> chunk) emptySourceInfo
68
69infoExpired :: UTCTime -> SourceInfo -> Bool
70infoExpired now (SourceInfo _ _ _ _ lastUpdated expires _ _ ) =
71        diffUTCTime now lastUpdated > fromInteger (expires * 60 * 60)
72
73lineComment :: Line -> String
74lineComment (Line _ (Comment text)) = text
75lineComment _ = ""
76
77parseInfo :: String -> State SourceInfo ()
78parseInfo text = do
79    info <- get
80    let urlParser = (\x -> info{_url = x}) <$> ((string "Url: " <|> string "Redirect: ") *> many1 anyChar)
81        titleParser = (\x -> info{_title = x}) <$> (string "Title: " *> many1 anyChar)
82        homepageParser = (\x -> info{_homepage = x}) <$> (string "Homepage: " *> many1 anyChar)
83        lastUpdatedParser = (\x -> case x of
84                                        Just time -> info{_lastUpdated = time}
85                                        Nothing   -> info)
86            . parseTimeM True defaultTimeLocale "%d %b %Y %H:%M %Z"
87            <$> (string "Last modified: " *> many1 anyChar)
88        licenseParser = (\x -> info{_license = x})
89            <$> ((string "Licen" <|> string "Лицензия") *> manyTill anyChar (char ':')
90                *> skipMany (char ' ') *> many1 anyChar)
91        expiresParser = (\n unit -> info{_expires = unit * read n})
92            <$> (string "Expires: " *> many1 digit) <*> (24 <$ string " days" <|> 1 <$ string " hours")
93        versionParser = (\x -> info{_version = read x}) <$> (string "Version: " *> many1 digit)
94        stringParser = skipMany (char ' ') *>
95            (try urlParser <|> try titleParser <|> try expiresParser <|> try versionParser
96              <|> try licenseParser <|> try homepageParser <|> try lastUpdatedParser)
97    case parse stringParser "" text of
98        Left _ -> return ()
99        Right info' -> put info'
Note: See TracBrowser for help on using the repository browser.