33 lines
1.1 KiB
Haskell
33 lines
1.1 KiB
Haskell
{-# LANGUAGE PackageImports #-}
|
|
|
|
module Main (main) where
|
|
|
|
import "foldl" Control.Foldl (Fold(..))
|
|
import qualified "foldl" Control.Foldl as Foldl
|
|
import "base" Control.Monad (forever)
|
|
import "base" Data.Bool (bool)
|
|
import "https-everywhere-rules" Data.HTTPSEverywhere.Rules (rewriteURL, RuleSet, getRulesets)
|
|
import "base" Data.Maybe (isJust)
|
|
import "base" Data.Monoid (Sum(..))
|
|
import "network-uri" Network.URI (URI, parseURI)
|
|
import "pipes" Pipes (Pipe, Producer, lift, yield, await, (>->))
|
|
import "pipes" Pipes.Prelude (stdinLn)
|
|
import qualified "pipes" Pipes.Prelude as Pipes (fold)
|
|
|
|
parse :: Monad m => Pipe String URI m ()
|
|
parse = forever $ parseURI <$> await >>= maybe (return ()) yield
|
|
|
|
check :: [RuleSet] -> Pipe URI Bool IO ()
|
|
check rs = forever $ await >>= yield . isJust . rewriteURL rs
|
|
|
|
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
|
|
rulesets <- getRulesets
|
|
fold proportion (stdinLn >-> parse >-> check rulesets) >>= print
|