33 lines
1007 B
Haskell
33 lines
1007 B
Haskell
module Main (main) where
|
|
|
|
import Network.URI (URI, parseURI)
|
|
import Data.HTTPSEverywhere.Rules (rewriteURL, RuleSet, getRulesets)
|
|
import Pipes (Pipe, Producer, lift, yield, await, (>->))
|
|
import Pipes.Prelude (stdinLn)
|
|
import qualified Pipes.Prelude as Pipes (fold)
|
|
import Control.Monad (forever)
|
|
import Control.Foldl (Fold(..))
|
|
import qualified Control.Foldl as Foldl
|
|
import Data.Monoid (Sum(..))
|
|
import Data.Bool (bool)
|
|
|
|
parse :: Monad m => Pipe String URI m ()
|
|
parse = forever $ parseURI <$> await >>= maybe (return ()) yield
|
|
|
|
check :: [RuleSet] -> Pipe URI Bool IO ()
|
|
check rules = forever $ do
|
|
src <- await
|
|
tgt <- lift $ rewriteURL rules src
|
|
yield $ src /= tgt
|
|
|
|
fold :: Monad m => Fold a b -> Producer a m () -> m b
|
|
fold (Fold step begin done) = Pipes.fold step begin done
|
|
|
|
proportion :: Fold Bool (Int, Int)
|
|
proportion = (,) <$> Foldl.foldMap (Sum . bool 0 1) getSum <*> Foldl.length
|
|
|
|
main :: IO ()
|
|
main = do
|
|
rules <- getRulesets
|
|
fold proportion (stdinLn >-> parse >-> check rules) >>= print
|