mono-traversable wip

Author: functora

ghcjs/lightning-verifier/src/App/Widgets/Bolt11.hs

@@ -10,6 +10,7 @@ import qualified Bitcoin.Address as Btc
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text.Lazy as TL
 import qualified Functora.Bolt11 as B11
 import Functora.Miso.Prelude
 import qualified Functora.Miso.Widgets.FieldPairs as FieldPairs
@@ -195,7 +196,7 @@ invoiceFields ln =
           >>= invoiceFieldsTag ln
        )
     <> [ pair "Signature"
-          . toMisoString @Prelude.String
+          . toMisoString @TL.Text
           . B11.inspectHex
           $ B11.bolt11SigVal sig,
          pair "Pubkey Recovery Flag"
@@ -245,7 +246,7 @@ invoiceFieldsTag ln = \case
     hex x =
       pure
         . pair x
-        . toMisoString @Prelude.String
+        . toMisoString @TL.Text
         . B11.inspectHex
 
 preimageFields :: MisoString -> ByteString -> [FieldPair DynamicField Identity]

ghcjs/miso-widgets/src/Functora/Miso/Prelude.hs

@@ -17,6 +17,7 @@ import Functora.Prelude as X hiding
   ( Field (..),
     String,
     Text,
+    cons,
     field,
     inspect,
   )
@@ -45,9 +46,9 @@ instance Binary MisoString where
   get = fmap (toMisoString @Prelude.Text) Binary.get
 
 instance ConvertUtf8 MisoString ByteString where
-  encodeUtf8 = encodeUtf8 . fromMisoString @Prelude.Text
-  decodeUtf8 = toMisoString @Prelude.Text . decodeUtf8
-  decodeUtf8Strict = fmap (toMisoString @Prelude.Text) . decodeUtf8Strict
+  encodeUtf8 = encodeUtf8 . fromMisoString @Prelude.String
+  decodeUtf8 = toMisoString @Prelude.String . decodeUtf8
+  decodeUtf8Strict = fmap (toMisoString @Prelude.String) . decodeUtf8Strict
 
 instance ToJSONKey MisoString where
   toJSONKey = contramap (fromMisoString @Prelude.Text) $ toJSONKey

pub/functora/functora.cabal

@@ -103,6 +103,7 @@ common pkg-prelude
     , microlens-ghc
     , microlens-th
     , modern-uri
+    , mono-traversable
     , random
     , safe-exceptions
     , scientific
@@ -130,7 +131,6 @@ common pkg-qr
     , bmp
     , bytestring
     , qrcode-core
-    , text
     , vector
 
 common pkg-aes

pub/functora/src/bolt11/Functora/Bolt11.hs

@@ -40,8 +40,7 @@ import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Builder as BS
 import qualified Data.ByteString.Lazy.Char8 as BL
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy as TL
 import Functora.Prelude hiding (error)
 import Prelude (Show (..), error)
 
@@ -51,12 +50,13 @@ newtype Hex = Hex
   deriving stock (Eq, Ord, Data, Generic)
 
 instance Show Hex where
-  show = inspectHex
+  show =
+    from @TL.Text @String
+      . inspectHex
 
-inspectHex :: forall a. (From String a) => Hex -> a
+inspectHex :: Hex -> TL.Text
 inspectHex =
-  from @String @a
-    . BL.unpack
+  decodeUtf8
     . BS.toLazyByteString
     . BS.byteStringHex
     . unHex
@@ -66,8 +66,7 @@ instance IsString Hex where
     Hex
       . handler
       . B16.decode
-      . T.encodeUtf8
-      . T.pack
+      . encodeUtf8 @String @ByteString
     where
 #if MIN_VERSION_base16_bytestring(1,0,0)
       handler :: Either String ByteString -> ByteString
@@ -126,20 +125,18 @@ data FeatureName
   | Unknown_feature
   deriving stock (Eq, Ord, Show, Data, Generic)
 
-inspectFeature :: forall a. (From Text a) => Feature -> a
+inspectFeature :: forall a. (Textual a) => Feature -> a
 inspectFeature x =
-  from @Text @a
-    $ "("
+  "("
     <> inspect (featureBits x)
     <> ") "
-    <> T.toLower (inspect $ featureName x)
+    <> toLower (inspect $ featureName x)
     <> " "
-    <> T.toLower (inspect $ featureRequiredOrSuported x)
+    <> toLower (inspect $ featureRequiredOrSuported x)
 
-inspectFeatures :: forall a. (From Text a) => [Feature] -> a
+inspectFeatures :: (Textual a) => [Feature] -> a
 inspectFeatures =
-  from @Text @a
-    . T.intercalate ", "
+  intercalate ", "
     . fmap inspectFeature
 
 parseFeatures :: [Word5] -> [Feature]
@@ -211,18 +208,18 @@ data Route = Route
 instance A.ToJSON Route where
   toJSON x =
     A.object
-      [ "pubkey" A..= inspectHex @Text (routePubKey x),
-        "short_channel_id" A..= inspectHex @Text (routeShortChanId x),
+      [ "pubkey" A..= inspectHex (routePubKey x),
+        "short_channel_id" A..= inspectHex (routeShortChanId x),
         "fee_base_msat" A..= routeFeeBaseMsat x,
         "fee_proportional_millionths" A..= routeFeePropMillionth x,
         "cltv_expiry_delta" A..= routeCltvExpiryDelta x
       ]
   toEncoding x =
     A.pairs
       $ "pubkey"
-      A..= inspectHex @Text (routePubKey x)
+      A..= inspectHex (routePubKey x)
         <> "short_channel_id"
-      A..= inspectHex @Text (routeShortChanId x)
+      A..= inspectHex (routeShortChanId x)
         <> "fee_base_msat"
       A..= routeFeeBaseMsat x
         <> "fee_proportional_millionths"

pub/functora/src/functora-ghcjs.cabal

@@ -105,6 +105,7 @@ common pkg
     , microlens-ghc
     , microlens-th
     , modern-uri                >=0.3.4.4
+    , mono-traversable
     , network-uri
     , optparse-applicative
     , pkcs7

pub/functora/src/prelude/Functora/Prelude.hs

@@ -59,7 +59,6 @@ module Functora.Prelude
 
     -- * Parsers
     -- $parsers
-    parseWords,
     parseRatio,
     utf8FromLatin1,
 
@@ -110,6 +109,11 @@ module Functora.Prelude
     enumerateNE,
     nextEnum,
     prevEnum,
+    Textual,
+    strip,
+    Mono,
+    dropAround,
+    dropWhileEnd,
   )
 where
 
@@ -171,6 +175,7 @@ import Data.ByteString.Base58 as X
     rippleAlphabet,
   )
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.Char as Char
 import qualified Data.Digest.SHA256 as SHA256
 import Data.Either.Extra as X (fromEither)
 import Data.Fixed as X (Pico)
@@ -193,10 +198,41 @@ import qualified Data.HMAC as HMAC
 import Data.List.Extra as X (enumerate, notNull, nubOrd, nubOrdBy, nubOrdOn)
 import qualified Data.Map.Merge.Strict as Map
 import Data.Maybe as X (listToMaybe)
+import qualified Data.MonoTraversable as Mono
+import Data.MonoTraversable.Unprefixed as X (intercalate)
 import Data.Ratio as X ((%))
 import Data.Scientific as X (Scientific)
 import qualified Data.Scientific as Scientific
 import qualified Data.Semigroup as Semigroup
+import Data.Sequences as X hiding
+  ( Textual,
+    Utf8 (..),
+    break,
+    catMaybes,
+    drop,
+    dropWhile,
+    filter,
+    filterM,
+    find,
+    fromList,
+    group,
+    groupBy,
+    intersperse,
+    isPrefixOf,
+    permutations,
+    replicate,
+    replicateM,
+    reverse,
+    sort,
+    sortBy,
+    sortOn,
+    splitAt,
+    subsequences,
+    take,
+    takeWhile,
+    uncons,
+  )
+import qualified Data.Sequences as Seq
 import Data.Tagged as X (Tagged (..))
 import qualified Data.Text as T
 import Data.Text.Encoding as X (decodeLatin1)
@@ -252,7 +288,11 @@ import Universum as X hiding
     finally,
     fromInteger,
     fromIntegral,
+    fromStrict,
     handleAny,
+    inits,
+    intercalate,
+    lines,
     on,
     over,
     preview,
@@ -261,10 +301,15 @@ import Universum as X hiding
     show,
     state,
     swap,
+    tails,
     throwM,
+    toStrict,
     try,
     tryAny,
+    unlines,
+    unwords,
     view,
+    words,
     (%~),
     (.~),
     (^.),
@@ -644,9 +689,6 @@ throwString =
 -- $parsers
 -- Parsers
 
-parseWords :: forall a. (From a Text) => a -> [Text]
-parseWords = filter (not . null) . T.splitOn " " . from @a @Text
-
 parseRatio ::
   forall str int m.
   ( From str Text,
@@ -986,3 +1028,32 @@ prevEnum :: (Eq a, Enum a, Bounded a) => a -> a
 prevEnum x
   | x == minBound = maxBound
   | otherwise = pred x
+
+type Textual mono =
+  ( Seq.Textual mono,
+    Container mono
+  )
+
+strip :: (Textual mono) => mono -> mono
+strip =
+  dropAround Char.isSpace
+
+type Mono a mono =
+  ( a ~ Mono.Element mono,
+    Seq.IsSequence mono,
+    Container mono
+  )
+
+dropAround :: (Mono a mono) => (a -> Bool) -> mono -> mono
+dropAround f =
+  Seq.dropWhile f . dropWhileEnd f
+
+dropWhileEnd :: (Mono a mono) => (a -> Bool) -> mono -> mono
+dropWhileEnd f =
+  Mono.ofoldr
+    ( \x xs ->
+        if f x && null xs
+          then mempty
+          else Seq.cons x xs
+    )
+    mempty

pub/functora/src/qr/Functora/Qr.hs

@@ -6,7 +6,6 @@ module Functora.Qr
 
     -- * URL
     qrToBmpDataUrlBL,
-    qrToBmpDataUrlTL,
   )
 where
 
@@ -16,8 +15,6 @@ import Codec.QRCode (QRImage (..))
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64.Lazy as B64L
 import qualified Data.ByteString.Lazy as BL
-import qualified Data.ByteString.Lazy.Char8 as BLC8
-import qualified Data.Text.Lazy as TL
 import qualified Data.Vector.Unboxed as UV
 import Functora.Prelude
 
@@ -109,21 +106,3 @@ qrToBmpDataUrlBL border scale =
     . B64L.encode
     . BMP.renderBMP
     . qrToBmp border scale
-
--- | Convert an QR code into a text-like Uri.
---   Has the same arguments as `qrToBmp`.
---   This can be used to display a image in HTML without creating a temporary file.
-qrToBmpDataUrlTL ::
-  forall a.
-  ( From TL.Text a
-  ) =>
-  Border ->
-  Scale ->
-  QRImage ->
-  a
-{-# INLINE qrToBmpDataUrlTL #-}
-qrToBmpDataUrlTL border scale =
-  from @TL.Text @a
-    . TL.pack
-    . BLC8.unpack
-    . qrToBmpDataUrlBL border scale

pub/functora/src/test/Functora/QrSpec.hs

@@ -33,10 +33,10 @@ spec = do
     putStrLn . Prelude.show $ diffUTCTime ts1 ts0
     True `shouldBe` True
   it "qrToBmpDataUrlTL/0/0" $ do
-    qrToBmpDataUrlTL @Text 0 0 <$> sample
+    qrToBmpDataUrlBL @ByteString 0 0 <$> sample
       `shouldBe` Just
         "data:image/bmp;base64,Qk0aBwAAAAAAADYAAAAoAAAAFQAAABUAAAABACAAAAAAAOQGAAASCwAAEgsAAAAAAAAAAAAAAAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA//////8AAAD/AAAA/wAAAP8AAAD///////////8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA////////////////////////////AAAA////////////AAAA////////////AAAA//////8AAAD///////////////////////////8AAAD/AAAA//////8AAAD/AAAA/wAAAP//////AAAA////////////AAAA/wAAAP////////////////8AAAD//////wAAAP8AAAD/AAAA//////8AAAD/AAAA//////8AAAD/AAAA/wAAAP//////AAAA//////8AAAD//////wAAAP8AAAD/AAAA//////8AAAD//////wAAAP8AAAD/AAAA//////8AAAD/AAAA//////8AAAD/AAAA/wAAAP//////AAAA////////////AAAA/wAAAP//////AAAA//////8AAAD//////wAAAP8AAAD/AAAA//////8AAAD/AAAA////////////////////////////AAAA////////////AAAA//////8AAAD///////////8AAAD///////////////////////////8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA//////8AAAD//////wAAAP//////AAAA//////8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD/////////////////////////////////////////////////AAAA////////////AAAA//////////////////////////////////////////////////////8AAAD//////wAAAP8AAAD/AAAA//////8AAAD///////////8AAAD/AAAA/wAAAP////////////////8AAAD///////////8AAAD///////////8AAAD/AAAA/wAAAP///////////wAAAP////////////////8AAAD/AAAA//////8AAAD///////////////////////////8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP//////AAAA/////////////////////////////////wAAAP///////////wAAAP8AAAD/AAAA//////////////////////8AAAD/AAAA/wAAAP8AAAD///////////8AAAD/AAAA//////8AAAD/////////////////////////////////////////////////AAAA////////////AAAA/wAAAP8AAAD/AAAA/////////////////wAAAP////////////////8AAAD//////wAAAP8AAAD/AAAA/wAAAP8AAAD///////////////////////////////////////////8AAAD//////wAAAP///////////wAAAP//////AAAA//////8AAAD/AAAA/wAAAP//////AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA//////////////////////8AAAD///////////8AAAD/AAAA//////////////////////8AAAD/AAAA////////////////////////////AAAA//////8AAAD/AAAA////////////////////////////AAAA/wAAAP8AAAD//////wAAAP8AAAD/AAAA//////8AAAD/AAAA/wAAAP//////AAAA//////8AAAD//////wAAAP8AAAD/////////////////AAAA////////////AAAA//////8AAAD/AAAA//////8AAAD/AAAA/wAAAP//////AAAA////////////AAAA////////////AAAA//////8AAAD/////////////////AAAA/wAAAP//////AAAA//////8AAAD/AAAA/wAAAP//////AAAA//////8AAAD//////wAAAP//////AAAA/////////////////wAAAP////////////////8AAAD/AAAA////////////////////////////AAAA////////////////////////////AAAA/wAAAP8AAAD/////////////////AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA////////////AAAA/////////////////////////////////wAAAP//////AAAA//////8AAAD/"
   it "qrToBmpDataUrlTL/1/0" $ do
-    qrToBmpDataUrlTL @Text 1 0 <$> sample
+    qrToBmpDataUrlBL @ByteString 1 0 <$> sample
       `shouldBe` Just
         "data:image/bmp;base64,Qk16CAAAAAAAADYAAAAoAAAAFwAAABcAAAABACAAAAAAAEQIAAASCwAAEgsAAAAAAAAAAAAA////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA//////8AAAD/AAAA/wAAAP8AAAD///////////8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD///////////8AAAD///////////////////////////8AAAD///////////8AAAD///////////8AAAD//////wAAAP///////////////////////////wAAAP///////////wAAAP//////AAAA/wAAAP8AAAD//////wAAAP///////////wAAAP8AAAD/////////////////AAAA//////8AAAD/AAAA/wAAAP//////AAAA////////////AAAA//////8AAAD/AAAA/wAAAP//////AAAA//////8AAAD//////wAAAP8AAAD/AAAA//////8AAAD//////wAAAP8AAAD/AAAA//////8AAAD///////////8AAAD//////wAAAP8AAAD/AAAA//////8AAAD///////////8AAAD/AAAA//////8AAAD//////wAAAP//////AAAA/wAAAP8AAAD//////wAAAP///////////wAAAP///////////////////////////wAAAP///////////wAAAP//////AAAA////////////AAAA////////////////////////////AAAA////////////AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA//////8AAAD//////wAAAP//////AAAA//////8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP8AAAD///////////////////////////////////////////////////////////8AAAD///////////8AAAD/////////////////////////////////////////////////////////////////AAAA//////8AAAD/AAAA/wAAAP//////AAAA////////////AAAA/wAAAP8AAAD/////////////////AAAA////////////AAAA//////////////////////8AAAD/AAAA/wAAAP///////////wAAAP////////////////8AAAD/AAAA//////8AAAD///////////////////////////8AAAD///////////8AAAD/AAAA/wAAAP8AAAD/AAAA//////8AAAD/////////////////////////////////AAAA////////////AAAA/wAAAP8AAAD/////////////////////////////////AAAA/wAAAP8AAAD/AAAA////////////AAAA/wAAAP//////AAAA////////////////////////////////////////////////////////////AAAA////////////AAAA/wAAAP8AAAD/AAAA/////////////////wAAAP////////////////8AAAD//////wAAAP8AAAD/AAAA/wAAAP8AAAD//////////////////////////////////////////////////////wAAAP//////AAAA////////////AAAA//////8AAAD//////wAAAP8AAAD/AAAA/////////////////wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP//////////////////////AAAA////////////AAAA/wAAAP//////////////////////AAAA////////////AAAA////////////////////////////AAAA//////8AAAD/AAAA////////////////////////////AAAA/wAAAP8AAAD//////wAAAP8AAAD///////////8AAAD//////wAAAP8AAAD/AAAA//////8AAAD//////wAAAP//////AAAA/wAAAP////////////////8AAAD///////////8AAAD//////wAAAP///////////wAAAP//////AAAA/wAAAP8AAAD//////wAAAP///////////wAAAP///////////wAAAP//////AAAA/////////////////wAAAP8AAAD/////////////////AAAA//////8AAAD/AAAA/wAAAP//////AAAA//////8AAAD//////wAAAP//////AAAA/////////////////wAAAP////////////////8AAAD///////////8AAAD///////////////////////////8AAAD///////////////////////////8AAAD/AAAA/wAAAP////////////////8AAAD/AAAA/wAAAP///////////wAAAP8AAAD/AAAA/wAAAP8AAAD/AAAA/wAAAP///////////wAAAP////////////////////////////////8AAAD//////wAAAP//////AAAA/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////w=="