From 3b09af0c36237953c4d7930929bcce9573e3f526 Mon Sep 17 00:00:00 2001
From: Sean D Gillespie <sean@mistersg.net>
Date: Sat, 10 Feb 2024 23:16:21 -0500
Subject: [PATCH] refactor(lib): Create a Utils module

---
 gibberish.cabal                    |  4 +-
 src/Data/Gibberish/GenPass.hs      | 61 +-------------------------
 src/Data/Gibberish/Utils.hs        | 69 ++++++++++++++++++++++++++++++
 test/Data/Gibberish/GenPassSpec.hs |  6 +--
 test/Data/Gibberish/UtilsSpec.hs   | 65 ++++++++++++++++++++++++++++
 5 files changed, 142 insertions(+), 63 deletions(-)
 create mode 100644 src/Data/Gibberish/Utils.hs
 create mode 100644 test/Data/Gibberish/UtilsSpec.hs

diff --git a/gibberish.cabal b/gibberish.cabal
index c47b199..d49204a 100644
--- a/gibberish.cabal
+++ b/gibberish.cabal
@@ -103,7 +103,8 @@ library
     Data.Gibberish.GenPass,
     Data.Gibberish.MonadPass,
     Data.Gibberish.Trigraph,
-    Data.Gibberish.Types
+    Data.Gibberish.Types,
+    Data.Gibberish.Utils
   other-modules:
     Paths_gibberish
   build-depends:
@@ -166,6 +167,7 @@ test-suite spec
     Data.Gibberish.GenPassSpec
     Data.Gibberish.TrigraphSpec
     Data.Gibberish.TypesSpec
+    Data.Gibberish.UtilsSpec
     Paths_gibberish
   other-extensions:
     OverloadedLists
diff --git a/src/Data/Gibberish/GenPass.hs b/src/Data/Gibberish/GenPass.hs
index 09fc909..61deda4 100644
--- a/src/Data/Gibberish/GenPass.hs
+++ b/src/Data/Gibberish/GenPass.hs
@@ -3,11 +3,11 @@
 
 module Data.Gibberish.GenPass
   ( genPassword,
-    numeralConversions,
   ) where
 
 import Data.Gibberish.MonadPass (MonadRandom ())
 import Data.Gibberish.Types
+import Data.Gibberish.Utils
 
 import Control.Arrow ((>>>))
 import Control.Monad ((>=>))
@@ -107,69 +107,12 @@ digitize1 _ t
   | null candidates = pure t
   | otherwise = digitize1' =<< uniform candidates
   where
-    candidates :: [Int]
     candidates = findIndices (`elem` Map.keys numeralConversions) t
-    digitize1' :: MonadRandom m => Int -> m Text
-    digitize1' pos = update1 (uniform . toDigit) t pos
+    digitize1' = update1 (uniform . toDigit) t
 
 digitizeR :: MonadRandom m => Text -> m Text
 digitizeR = updateR (uniform . toDigit) (1 % 6)
 
--- | A mapping from letters to numbers that look like them
-numeralConversions :: Map Char [Char]
-numeralConversions =
-  Map.fromList
-    [ ('o', ['0']),
-      ('l', ['1']),
-      ('z', ['2']),
-      ('e', ['3']),
-      ('a', ['4']),
-      ('s', ['5']),
-      ('g', ['6', '9']),
-      ('t', ['7']),
-      ('b', ['8'])
-    ]
-
 -- | Map a letter to one or more digits, if possible
 toDigit :: Char -> [Char]
 toDigit c = fromMaybe [c] (numeralConversions Map.!? c)
-
--- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the
--- indices of all elements satisfying the predicate, in ascending order.
-findIndices :: (Char -> Bool) -> Text -> [Int]
-findIndices p = loop 0
-  where
-    loop !n !qs = case Text.findIndex p qs of
-      Just !i ->
-        let !j = n + i
-        in j : loop (j + 1) (Text.drop (i + 1) qs)
-      Nothing -> []
-{-# INLINE [1] findIndices #-}
-
-update1 :: Monad m => (Char -> m Char) -> Text -> Int -> m Text
-update1 f t pos =
-  case Text.splitAt pos t of
-    (prefix, suffix) ->
-      case Text.uncons suffix of
-        Nothing -> pure t
-        Just (ch, suffix') -> do
-          ch' <- f ch
-          pure $ prefix `Text.append` (ch' `Text.cons` suffix')
-
-updateR :: MonadRandom m => (Char -> m Char) -> Rational -> Text -> m Text
-updateR f prob t = textTraverse updateR' t
-  where
-    updateR' ch = do
-      ch' <- f ch
-      fromList
-        [ (ch, toRational $ denominator prob),
-          (ch', toRational $ numerator prob)
-        ]
-
-textTraverse :: Monad m => (Char -> m Char) -> Text -> m Text
-textTraverse f = Text.foldr folder (pure Text.empty)
-  where
-    folder c accum = do
-      accum' <- accum
-      c' <- f c
-      pure $ Text.cons c' accum'
diff --git a/src/Data/Gibberish/Utils.hs b/src/Data/Gibberish/Utils.hs
new file mode 100644
index 0000000..b618a2e
--- /dev/null
+++ b/src/Data/Gibberish/Utils.hs
@@ -0,0 +1,69 @@
+module Data.Gibberish.Utils
+  ( numeralConversions,
+    update1,
+    updateR,
+    findIndices,
+    textTraverse,
+  ) where
+
+import Control.Monad.Random (MonadRandom (), fromList)
+import Data.Map (Map ())
+import Data.Map qualified as Map
+import Data.Ratio (denominator, numerator)
+import Data.Text (Text ())
+import Data.Text qualified as Text
+
+-- | A mapping from letters to numbers that look like them
+numeralConversions :: Map Char [Char]
+numeralConversions =
+  Map.fromList
+    [ ('o', ['0']),
+      ('l', ['1']),
+      ('z', ['2']),
+      ('e', ['3']),
+      ('a', ['4']),
+      ('s', ['5']),
+      ('g', ['6', '9']),
+      ('t', ['7']),
+      ('b', ['8'])
+    ]
+
+update1 :: Monad m => (Char -> m Char) -> Text -> Int -> m Text
+update1 f t pos =
+  case Text.splitAt pos t of
+    (prefix, suffix) ->
+      case Text.uncons suffix of
+        Nothing -> pure t
+        Just (ch, suffix') -> do
+          ch' <- f ch
+          pure $ prefix `Text.append` (ch' `Text.cons` suffix')
+
+updateR :: MonadRandom m => (Char -> m Char) -> Rational -> Text -> m Text
+updateR f prob = textTraverse updateR'
+  where
+    updateR' ch = do
+      ch' <- f ch
+      fromList
+        [ (ch, toRational $ denominator prob),
+          (ch', toRational $ numerator prob)
+        ]
+
+-- | /O(n)/ The 'findIndices' function extends 'findIndex', by returning the
+-- indices of all elements satisfying the predicate, in ascending order.
+findIndices :: (Char -> Bool) -> Text -> [Int]
+findIndices p = loop 0
+  where
+    loop !n !qs = case Text.findIndex p qs of
+      Just !i ->
+        let !j = n + i
+        in j : loop (j + 1) (Text.drop (i + 1) qs)
+      Nothing -> []
+{-# INLINE [1] findIndices #-}
+
+textTraverse :: Monad m => (Char -> m Char) -> Text -> m Text
+textTraverse f = Text.foldr folder (pure Text.empty)
+  where
+    folder c accum = do
+      accum' <- accum
+      c' <- f c
+      pure $ Text.cons c' accum'
diff --git a/test/Data/Gibberish/GenPassSpec.hs b/test/Data/Gibberish/GenPassSpec.hs
index f878a1c..ad124c0 100644
--- a/test/Data/Gibberish/GenPassSpec.hs
+++ b/test/Data/Gibberish/GenPassSpec.hs
@@ -1,14 +1,14 @@
 module Data.Gibberish.GenPassSpec (spec) where
 
-import Data.Gibberish.GenPass (genPassword, numeralConversions)
+import Data.Gibberish.GenPass (genPassword)
 import Data.Gibberish.MonadPass (usingPass)
 import Data.Gibberish.Trigraph (Language (..), loadTrigraph)
 import Data.Gibberish.Types (GenPassOptions (..), Word (..))
+import Data.Gibberish.Utils (numeralConversions)
 import Test.Gibberish.Gen qualified as Gen
 
 import Control.Monad.IO.Class (liftIO)
 import Data.Char
-import Data.Map (Map ())
 import Data.Map qualified as Map
 import Data.Text qualified as Text
 import Hedgehog
@@ -89,5 +89,5 @@ spec = do
       annotateShow pass
 
       assert $
-        Text.any (\c -> isNumber c) pass
+        Text.any isNumber pass
           || Text.all (`Map.notMember` numeralConversions) pass
diff --git a/test/Data/Gibberish/UtilsSpec.hs b/test/Data/Gibberish/UtilsSpec.hs
new file mode 100644
index 0000000..3093096
--- /dev/null
+++ b/test/Data/Gibberish/UtilsSpec.hs
@@ -0,0 +1,65 @@
+module Data.Gibberish.UtilsSpec (spec) where
+
+import Data.Gibberish.MonadPass (usingPass)
+import Data.Gibberish.Utils
+import Test.Gibberish.Gen qualified as Gen
+
+import Data.Char (isLowerCase, isUpperCase, toUpper)
+import Data.Maybe (listToMaybe)
+import Data.Ratio ((%))
+import Data.Text qualified as Text
+import Hedgehog
+import Hedgehog.Gen qualified as Gen
+import Hedgehog.Range qualified as Range
+import Test.Hspec
+import Test.Hspec.Hedgehog
+
+spec :: Spec
+spec = do
+  describe "update1" $ do
+    it "updates at index" $ hedgehog $ do
+      t <- forAll $ Gen.text (Range.linear 1 250) Gen.lower
+      ix <- forAll $ Gen.int (Range.linear 0 (Text.length t - 1))
+      res <- update1 (pure . toUpper) t ix
+
+      assert $ isUpperCase (Text.index res ix)
+
+  describe "updateR" $ do
+    it "updates everything when ratio is infinity" $ hedgehog $ do
+      t <- forAll $ Gen.text (Range.linear 1 250) Gen.lower
+      randomGen <- forAll Gen.stdGen
+
+      -- Make numerator absurdly high since we can't use 0 in the denominator
+      let prob = fromIntegral (maxBound :: Int) % 1
+          (res, _) = usingPass randomGen (updateR (pure . toUpper) prob t)
+      annotateShow res
+
+      assert $ Text.all isUpperCase res
+
+    it "updates nothing when ratio is zero" $ hedgehog $ do
+      t <- forAll $ Gen.text (Range.linear 1 250) Gen.lower
+      randomGen <- forAll Gen.stdGen
+
+      let (res, _) = usingPass randomGen (updateR (pure . toUpper) (0 % 1) t)
+      annotateShow res
+
+      assert $ Text.all isLowerCase res
+
+  describe "findIndices" $ do
+    it "agrees with findIndex" $ hedgehog $ do
+      t <- forAll $ Gen.text (Range.linear 1 250) Gen.digit
+      let mapper = (<= '5')
+      listToMaybe (findIndices mapper t) === Text.findIndex mapper t
+
+    it "agrees with filter" $ hedgehog $ do
+      t <- forAll $ Gen.text (Range.linear 1 250) Gen.digit
+      let p = (<= '5')
+      map (t `Text.index`) (findIndices p t) === Text.unpack (Text.filter p t)
+
+  describe "textTraverse" $ do
+    it "agrees with map" $ hedgehog $ do
+      t <- forAll $ Gen.text (Range.linear 1 250) Gen.lower
+      let mapper = pure . toUpper
+      res <- textTraverse mapper t
+
+      res === Text.map toUpper t