Skip to content

Commit 12659db

Browse files
functorafunctora
committed
TextualMonoid instance for JSString
1 parent 0cb9a8f commit 12659db

File tree

6 files changed

+140
-7
lines changed

6 files changed

+140
-7
lines changed

‎ghcjs/lightning-verifier/src/Main.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -323,6 +323,5 @@ syncUri uri = do
323323
$ pushURI
324324
=<< ( maybe (throwString $ "Bad URI " <> textUri) pure
325325
. URI.parseURI
326-
. from @Prelude.Text @Prelude.String
327-
$ URI.render nextUri
326+
$ URI.renderStr nextUri
328327
)

‎ghcjs/miso-widgets/miso-widgets.cabal‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -83,13 +83,17 @@ common pkg
8383
, miso
8484
, miso-components
8585
, modern-uri
86+
, monoid-subclasses
8687
, network-uri
8788
, qrcode-core
8889
, random
8990
, syb
9091
, text
9192
, uglymemo
9293

94+
if ((impl(ghcjs) || arch(javascript)) || os(wasi))
95+
build-depends: ghcjs-base
96+
9397
library
9498
import: pkg
9599
hs-source-dirs: src
@@ -106,6 +110,7 @@ library
106110
Functora.Miso.Jsm
107111
Functora.Miso.Jsm.Generic
108112
Functora.Miso.Jsm.Specific
113+
Functora.Miso.Orphan
109114
Functora.Miso.Prelude
110115
Functora.Miso.Types
111116
Functora.Miso.Widgets.Assets
@@ -143,6 +148,7 @@ test-suite miso-widgets-test
143148
Functora.Miso.Jsm
144149
Functora.Miso.Jsm.Generic
145150
Functora.Miso.Jsm.Specific
151+
Functora.Miso.Orphan
146152
Functora.Miso.Prelude
147153
Functora.Miso.Types
148154
Functora.Miso.Widgets.Assets

‎ghcjs/miso-widgets/src/Functora/Miso/Orphan.hs‎

Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
1+
{-# OPTIONS_GHC -Wno-orphans #-}
2+
3+
module Functora.Miso.Orphan () where
4+
5+
import Data.JSString (JSString)
6+
import qualified Data.JSString as JS
7+
import qualified Data.JSString.Text as JST
8+
import Data.Monoid.Factorial
9+
import Data.Monoid.GCD
10+
import Data.Monoid.Null
11+
import Data.Monoid.Textual
12+
import Data.Semigroup.Cancellative
13+
import Functora.Prelude
14+
15+
instance MonoidNull JSString where
16+
null = JS.null
17+
18+
instance Factorial JSString where
19+
factors = JS.chunksOf 1
20+
primePrefix = JS.take 1
21+
primeSuffix x = if JS.null x then JS.empty else JS.singleton (JS.last x)
22+
foldl f = JS.foldl f'
23+
where
24+
f' a char = f a (JS.singleton char)
25+
foldl' f = JS.foldl' f'
26+
where
27+
f' a char = f a (JS.singleton char)
28+
foldr f = JS.foldr f'
29+
where
30+
f' char a = f (JS.singleton char) a
31+
length = JS.length
32+
reverse = JS.reverse
33+
34+
instance LeftGCDMonoid JSString where
35+
stripCommonPrefix x y = maybe (JS.empty, x, y) id (JS.commonPrefixes x y)
36+
37+
instance LeftReductive JSString where
38+
stripPrefix = JS.stripPrefix
39+
isPrefixOf = JS.isPrefixOf
40+
41+
instance TextualMonoid JSString where
42+
fromText = JST.textToJSString
43+
singleton = JS.singleton
44+
splitCharacterPrefix = JS.uncons
45+
characterPrefix t = if JS.null t then Nothing else Just (JS.head t)
46+
map = JS.map
47+
concatMap = JS.concatMap
48+
toString = const JS.unpack
49+
toText = const JST.textFromJSString
50+
any = JS.any
51+
all = JS.all
52+
53+
foldl = const JS.foldl
54+
foldl' = const JS.foldl'
55+
foldr = const JS.foldr
56+
57+
scanl = JS.scanl
58+
scanl1 = JS.scanl1
59+
scanr = JS.scanr
60+
scanr1 = JS.scanr1
61+
mapAccumL = JS.mapAccumL
62+
mapAccumR = JS.mapAccumR
63+
64+
takeWhile _ = JS.takeWhile
65+
dropWhile _ = JS.dropWhile
66+
break _ = JS.break
67+
span _ = JS.span
68+
spanMaybe s0 _ft fc t = case JS.foldr g id t (0, s0) of
69+
(i, s') | (prefix, suffix) <- JS.splitAt i t -> (prefix, suffix, s')
70+
where
71+
g c cont (i, s)
72+
| Just s' <- fc s c = let i' = succ i :: Int in seq i' $ cont (i', s')
73+
| otherwise = (i, s)
74+
spanMaybe' s0 _ft fc t = case JS.foldr g id t (0, s0) of
75+
(i, s') | (prefix, suffix) <- JS.splitAt i t -> (prefix, suffix, s')
76+
where
77+
g c cont (i, s)
78+
| Just s' <- fc s c =
79+
let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
80+
| otherwise = (i, s)
81+
split = JS.split
82+
find = JS.find
83+
84+
instance FactorialMonoid JSString where
85+
splitPrimePrefix = fmap (first JS.singleton) . JS.uncons
86+
splitPrimeSuffix x =
87+
if JS.null x
88+
then Nothing
89+
else Just (JS.init x, JS.singleton (JS.last x))
90+
inits = JS.inits
91+
tails = JS.tails
92+
span f = JS.span (f . JS.singleton)
93+
break f = JS.break (f . JS.singleton)
94+
dropWhile f = JS.dropWhile (f . JS.singleton)
95+
takeWhile f = JS.takeWhile (f . JS.singleton)
96+
spanMaybe s0 f t = case JS.foldr g id t (0, s0) of
97+
(i, s') | (prefix, suffix) <- JS.splitAt i t -> (prefix, suffix, s')
98+
where
99+
g c cont (i, s)
100+
| Just s' <- f s (JS.singleton c) =
101+
let i' = succ i :: Int in seq i' $ cont (i', s')
102+
| otherwise = (i, s)
103+
spanMaybe' s0 f t = case JS.foldr g id t (0, s0) of
104+
(i, s') | (prefix, suffix) <- JS.splitAt i t -> (prefix, suffix, s')
105+
where
106+
g c cont (i, s)
107+
| Just s' <- f s (JS.singleton c) =
108+
let i' = succ i :: Int in seq i' $ seq s' $ cont (i', s')
109+
| otherwise = (i, s)
110+
split f = JS.split f'
111+
where
112+
f' = f . JS.singleton
113+
splitAt = JS.splitAt
114+
drop = JS.drop
115+
take = JS.take

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ where
1212
import qualified Data.Binary as Binary (get, put)
1313
#endif
1414
import Functora.Cfg as X
15+
import Functora.Miso.Orphan as X ()
1516
import Functora.Prelude as X hiding
1617
( Field (..),
1718
String,

‎ghcjs/miso-widgets/src/Functora/Miso/Widgets/Currency.hs‎

Lines changed: 7 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -153,13 +153,14 @@ currencyListWidget
153153
newFuzz cur =
154154
Fuzzy.Fuzzy
155155
{ Fuzzy.original = cur,
156-
Fuzzy.rendered = inspectCurrencyInfo cur,
156+
Fuzzy.rendered =
157+
toMisoString @Prelude.Text
158+
$ inspectCurrencyInfo cur,
157159
Fuzzy.score = 0
158160
}
159161
search =
160-
maybe
162+
fromMaybe
161163
mempty
162-
(fromMisoString @Prelude.Text)
163164
$ st
164165
^? cloneTraversal optic
165166
. #currencyInput
@@ -181,14 +182,15 @@ currencyListWidget
181182
)
182183
"<b>"
183184
"</b>"
184-
inspectCurrencyInfo
185+
( toMisoString @Prelude.Text . inspectCurrencyInfo
186+
)
185187
False
186188

187189
currencyListItemWidget ::
188190
Args model action ->
189191
Opts model ->
190192
CurrencyInfo ->
191-
Fuzzy.Fuzzy CurrencyInfo Prelude.Text ->
193+
Fuzzy.Fuzzy CurrencyInfo MisoString ->
192194
ListItem.ListItem action
193195
currencyListItemWidget
194196
Args

‎ghcjs/overlays.nix‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -155,6 +155,16 @@
155155
ver = "0.1";
156156
sha256 = "MkLhIuwjfLomAbbzV3ZI1SWKEKHufFwTcxgCtda4ohI=";
157157
} {};
158+
monoid-subclasses = self.callHackageDirect {
159+
pkg = "monoid-subclasses";
160+
ver = "1.2.5.1";
161+
sha256 = "E4MrV6/j5EDC9SdD0uEnViQpm9lrxpofyfp+gjWBQes=";
162+
} {};
163+
commutative-semigroups = self.callHackageDirect {
164+
pkg = "commutative-semigroups";
165+
ver = "0.2.0.1";
166+
sha256 = "awswOPDumlMe0AmCb6GgfM2qABp1Y/UxQahMLfj6OEg=";
167+
} {};
158168
base-orphans = self.callHackageDirect {
159169
pkg = "base-orphans";
160170
ver = "0.8.8.2";

0 commit comments

Comments
 (0)