From 52bf0fa6dace596a4bd5b4e4229fbb9704fbf443 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 18 Feb 2022 18:09:23 +0100
Subject: switch to universum prelude

also don't keep adjusted maps around if not necessary
---
 lib/Uris.hs | 44 +++++++++++++++++---------------------------
 1 file changed, 17 insertions(+), 27 deletions(-)

(limited to 'lib/Uris.hs')

diff --git a/lib/Uris.hs b/lib/Uris.hs
index 00f86a4..a8c7068 100644
--- a/lib/Uris.hs
+++ b/lib/Uris.hs
@@ -8,26 +8,16 @@
 -- | Functions to deal with uris and custom uri schemes
 module Uris where
 
+import           Universum
 
-
-import           Control.Monad           (unless, when)
-import           Data.Aeson              (FromJSON (..), Options (..),
-                                          SumEncoding (UntaggedValue),
-                                          defaultOptions, genericParseJSON)
-import           Data.Data               (Proxy)
-import           Data.Either.Combinators (maybeToRight, rightToMaybe)
-import           Data.Map.Strict         (Map)
-import qualified Data.Map.Strict         as M
-import           Data.Text               (Text, pack, unpack)
-import qualified Data.Text               as T
-import           GHC.Generics            (Generic)
-import           GHC.TypeLits            (KnownSymbol, symbolVal)
-import           Network.URI.Encode      as URI
-import           Text.Regex.TDFA         ((=~))
-import           Witherable              (mapMaybe)
-
-import           Data.String
-import           Network.URI             as NativeUri
+import           Data.Aeson         (FromJSON (..), Options (..),
+                                     SumEncoding (UntaggedValue),
+                                     defaultOptions, genericParseJSON)
+import qualified Data.Map.Strict    as M
+import qualified Data.Text          as T
+import           GHC.TypeLits       (KnownSymbol, symbolVal)
+import           Network.URI        (URI (..), URIAuth (..), parseURI)
+import qualified Network.URI.Encode as URI
 
 data Substitution =
     Prefixed { prefix :: Text, blocked :: [Text], allowed :: [Text], scope :: [String] }
@@ -56,7 +46,7 @@ extractDomain url =
 
 parseUri :: Text -> Maybe (Text, Text, Text)
 parseUri uri =
-  case parseURI (unpack uri) of
+  case parseURI (toString uri) of
     Nothing -> Nothing
     Just parsedUri -> case uriAuthority parsedUri of
         Nothing -> Nothing
@@ -84,15 +74,15 @@ data SubstError =
 applySubsts :: KnownSymbol s
   => Proxy s -> SchemaSet -> Text -> Either SubstError Text
 applySubsts s substs uri =  do
-  when (T.isInfixOf (pack "{{") uri || T.isInfixOf (pack "}}") uri)
+  when (T.isInfixOf (toText "{{") uri || T.isInfixOf (toText "}}") uri)
    $ Left VarsDisallowed
   parts@(schema, _, _) <- note NotALink $ parseUri uri
 
   let rules = filter ((==) schema . fst) substs
 
-  case fmap (applySubst parts . snd) rules of
-    []  -> Left (SchemaDoesNotExist schema)
-    results@(_:_) -> case mapMaybe rightToMaybe results of
+  case nonEmpty (map (applySubst parts . snd) rules) of
+    Nothing  -> Left (SchemaDoesNotExist schema)
+    Just results -> case rights (toList results) of
       suc:_ -> Right suc
       _     -> minimum results
 
@@ -104,14 +94,14 @@ applySubsts s substs uri =  do
          (fmap fst . filter (elem (symbolVal s) . scope . snd) $ substs))
       case rule of
         DomainSubstitution table _  -> do
-          prefix <- note (DomainDoesNotExist (schema <> pack "://" <> domain))
+          prefix <- note (DomainDoesNotExist (schema <> toText "://" <> domain))
                        $ M.lookup domain table
           pure (prefix <> rest)
         Prefixed {..}
           | domain `elem` blocked -> Left IsBlocked
-          | domain `elem` allowed || pack "streamproxy.rc3.world" `T.isSuffixOf` domain -> Right uri
+          | domain `elem` allowed || toText "streamproxy.rc3.world" `T.isSuffixOf` domain -> Right uri
           | otherwise -> Right (prefix <> URI.encodeText uri)
         Allowed _ domains -> if domain `elem` domains
-                    || pack "streamproxy.rc3.world" `T.isSuffixOf` domain
+                    || toText "streamproxy.rc3.world" `T.isSuffixOf` domain
           then Right uri
           else Left (DomainIsBlocked domains)
-- 
cgit v1.2.3