From e2d9556c6f48f1c5f266759893ffa13fb073dd7d Mon Sep 17 00:00:00 2001
From: vi <vi@computational.law>
Date: Tue, 5 Dec 2017 21:51:40 +0100
Subject: [PATCH] Another example: CountUpgradeable.

Given a sequence of URIs on stdin, count the number we know how to
rewrite, together with the total number input. Coverage analysis?
---
 examples/CountUpgradeable.hs | 32 ++++++++++++++++++++++++++++++++
 https-everywhere-rules.cabal | 18 ++++++++++++++++++
 2 files changed, 50 insertions(+)
 create mode 100644 examples/CountUpgradeable.hs

diff --git a/examples/CountUpgradeable.hs b/examples/CountUpgradeable.hs
new file mode 100644
index 0000000..7130705
--- /dev/null
+++ b/examples/CountUpgradeable.hs
@@ -0,0 +1,32 @@
+{-# 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)
+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 :: Pipe URI Bool IO ()
+check = forever $ do
+  src <- await
+  tgt <- lift $ rewriteURL 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 = fold proportion (stdinLn >-> parse >-> check) >>= print
diff --git a/https-everywhere-rules.cabal b/https-everywhere-rules.cabal
index 586e22e..e73412a 100644
--- a/https-everywhere-rules.cabal
+++ b/https-everywhere-rules.cabal
@@ -129,5 +129,23 @@ executable redirect-proxy
   if !(flag(build-examples))
     buildable:
       False
+  default-language:
+    Haskell2010
+
+executable count-upgradeable
+  hs-source-dirs:
+    examples
+  main-is:
+    CountUpgradeable.hs
+  if flag(build-examples)
+    build-depends:
+      base,
+      foldl,
+      https-everywhere-rules,
+      network-uri,
+      pipes
+  if !(flag(build-examples))
+    buildable:
+      False
   default-language:
     Haskell2010
\ No newline at end of file