1ea7c74 · isoparsec · git.iko.soy

git.iko.soy/isoparsec

Fixity (#36)

* Changed fixity * added hlint * fixed some warnings

commit1ea7c742c66348d83d02b9a7cb4ded1c67c418cd authoriko <ilyakooo0@gmail.com> dateSun 16 Feb 2020, 13:39 (7 years ago) parent02596d5

14 files changed+131−55

compare with master

unifiedsplit

.hlint.yaml+81−14 src/Control/Arrow/Extra.hs+4−4 src/Control/Arrow/Extra/ArrowChoice.hs+2−2 src/Control/Arrow/Extra/ArrowPlus.hs+1−1 src/Control/Arrow/Extra/BaseArrow.hs+15−3 src/Control/Arrow/Extra/PolyArrow.hs+3−4 src/Control/Tuple/Morph.hs+2−2 src/Data/Isoparsec.hs+2−2 src/Data/Isoparsec/ByteString.hs+4−3 src/Data/Isoparsec/Cokleisli.hs+2−4 src/Data/Isoparsec/Internal.hs+2−2 test/Spec/Megaparsec/BasicNums.hs+2−2 test/Spec/Ssh.hs+8−9 test/Spec/TwoDigits.hs+3−3

.hlint.yaml+81−14

@@ -86,17 +86,84 @@

8686 - -XUndecidableInstances

8787 - -XRankNTypes

8888

89−- fixity: "infixr 5 <+^"

90−- fixity: "infixr 5 ^+>"

91−- fixity: "infixr 5 ^+^"

92−- fixity: "infixr 2 +++"

93−- fixity: "infixr 2 |||"

94−- fixity: "infixr 5 <+>"

95−- fixity: "infixr 3 ***"

96−- fixity: "infixr 3 &&&"

97−- fixity: "infixr 1 ^>>"

98−- fixity: "infixr 1 >>^"

99−- fixity: "infixr 1 ^<<"

100−- fixity: "infixr 1 <<^"

101−- fixity: "infixr 1 ^>^"

102−- fixity: "infixr 1 ^<^"

89+# hints found in src/Control/SemiIso.hs

90+- warn: {lhs: "SI (pure . a) (pure . b)", rhs: "siPure a b"}

91+- warn: {lhs: "SemiIso (pure . a) (pure . b)", rhs: "siPure a b"}

92+- warn: {lhs: "SemiIso (const empty) (const empty)", rhs: "zeroArrow"}

93+

94+# hints found in src/Control/Arrow/Extra.hs

95+- fixity: "infixl 5 <+^"

96+- fixity: "infixl 5 ^+>"

97+- fixity: "infixl 5 ^+^"

98+- warn: {lhs: "a <+> arr b", rhs: "a <+^ b"}

99+- warn: {lhs: "arr a <+> b", rhs: "a ^+> b"}

100+- warn: {lhs: "arr a <+> arr b", rhs: "a ^+^ b"}

101+

102+# hints found in src/Control/Arrow/Extra/ArrowChoice.hs

103+- fixity: "infixl 2 +++"

104+- fixity: "infixl 2 |||"

105+

106+# hints found in src/Control/Arrow/Extra/ArrowPlus.hs

107+- fixity: "infixl 5 <+>"

108+

109+# hints found in src/Control/Arrow/Extra/ArrowZero.hs

110+# no hints found

111+

112+# hints found in src/Control/Arrow/Extra/BaseArrow.hs

113+- fixity: "infixl 3 ***"

114+- fixity: "infixl 3 &&&"

115+- fixity: "infixl 1 >>>"

116+- fixity: "infixl 1 <<<"

117+

118+# hints found in src/Control/Arrow/Extra/Orphans.hs

119+# no hints found

120+

121+# hints found in src/Control/Arrow/Extra/PolyArrow.hs

122+- fixity: "infixl 1 ^>>"

123+- fixity: "infixl 1 >>^"

124+- fixity: "infixl 1 ^<<"

125+- fixity: "infixl 1 <<^"

126+- fixity: "infixl 1 ^>^"

127+- fixity: "infixl 1 ^<^"

128+- warn: {lhs: "arr a >>> arr b", rhs: "a ^>^ b"}

129+- warn: {lhs: "arr a <<< arr b", rhs: "a ^<^ b"}

130+- warn: {lhs: "arr a >>> b", rhs: "a ^>> b"}

131+- warn: {lhs: "a >>> arr b", rhs: "a >>^ b"}

132+- warn: {lhs: "a <<< arr b", rhs: "a <<^ b"}

133+- warn: {lhs: "arr a <<< b", rhs: "a ^<< b"}

134+

135+# hints found in src/Data/Isoparsec.hs

136+- warn: {lhs: "a <+^ konst ()", rhs: "opt a"}

137+- warn: {lhs: "(b >>^ turn (konst a)) <+^ konst ()", rhs: "opt' a b"}

138+- warn: {lhs: "(a &&& (repeating a <+^ konst [])) >>^ siCons", rhs: "repeating a"}

139+- fixity: "infixl 0 <.>"

140+- warn: {lhs: "(b >>^ morphed) >>^ si a", rhs: "a <.> b"}

141+- warn: {lhs: "siPure coerce coerce", rhs: "coercing"}

142+- warn: {lhs: "siPure morphTuples morphTuples", rhs: "morphed"}

143+- warn: {lhs: "auto @x >>^ turn (konst a)", rhs: "specific a"}

144+- warn: {lhs: "arr (siPure fromIntegral fromIntegral)", rhs: "throughIntegral"}

145+

146+# hints found in src/Data/Isoparsec/ByteString.hs

147+- warn: {lhs: "arr (siPure C.unpack C.pack)", rhs: "utf8"}

148+- warn: {lhs: "bytesToIsoparsec (Proxy @e) >>^ coercing @(Byte16 e) @Word16", rhs: "toIsoparsec"}

149+- warn: {lhs: "bytesToIsoparsec (Proxy @e) >>^ coercing @(Byte32 e) @Word32", rhs: "toIsoparsec"}

150+- warn: {lhs: "bytesToIsoparsec (Proxy @e) >>^ coercing @(Byte64 e) @Word64", rhs: "toIsoparsec"}

151+- warn: {lhs: "anyToken >>> mapIso [(0, False), (1, True)]", rhs: "toIsoparsec"}

152+

153+# hints found in src/Data/Isoparsec/Char.hs

154+- warn: {lhs: "token ' '", rhs: "space"}

155+- warn: {lhs: "tokensWhile isSpace >>^ ((maskr . turn . konst) mempty)", rhs: "unsafeWhiteSpace"}

156+- warn: {lhs: "tokensWhile1 isSpace >>^ ((maskr . turn . konst) (singleton ' '))", rhs: "unsafeWhiteSpace1"}

157+

158+# hints found in src/Data/Isoparsec/Cokleisli.hs

159+- warn: {lhs: "Cokleisli\n (\\ t ->\n case project a t of\n Just x -> return x\n Nothing -> mzero)", rhs: "arr a"}

160+- warn: {lhs: "Cokleisli (const mzero)", rhs: "zeroArrow"}

161+

162+# hints found in src/Data/Isoparsec/Internal.hs

163+- warn: {lhs: "((a &&& arrowsWhile a) >>^ siCons) <+^ isoConst () []", rhs: "arrowsWhile a"}

164+- warn: {lhs: "siMaybe (pure . uncurry cons) uncons", rhs: "siCons"}

165+- warn: {lhs: "SI (\\ c -> guard (a c) >> b c)\n (c >=> (\\ c -> guard (a c) >> pure c))", rhs: "siCheck a b c"}

166+- warn: {lhs: "siCheck a (pure . b) (pure . c)", rhs: "isoCheck a b c"}

167+- warn: {lhs: "SI (const (pure b)) (const (pure a))", rhs: "isoConst a b"}

168+- warn: {lhs: "isoCheck a id id", rhs: "check a"}

169+- warn: {lhs: "SI (const (pure a)) (const (pure ())) >>> check (== a)", rhs: "konst a"}

src/Control/Arrow/Extra.hs+4−4

@@ -14,13 +14,13 @@ import Control.Arrow.Extra.ArrowPlus as X

1414import Control.Arrow.Extra.ArrowZero as X

1515import Control.Arrow.Extra.BaseArrow as X

1616import Control.Arrow.Extra.PolyArrow as X

17−import Control.Category as X

17+import Control.Category as X hiding ((<<<), (>>>))

1818

19−infixr 5 <+^

19+infixl 5 <+^

2020

21−infixr 5 ^+>

21+infixl 5 ^+>

2222

23−infixr 5 ^+^

23+infixl 5 ^+^

2424

2525(<+^) :: (ArrowPlus a, PolyArrow a p) => a b c -> p b c -> a b c

2626a <+^ b = a <+> arr b

src/Control/Arrow/Extra/ArrowChoice.hs+2−2

@@ -9,9 +9,9 @@ import Control.Arrow.Extra.BaseArrow

99import Control.Category

1010import Data.Either

1111

12−infixr 2 +++

12+infixl 2 +++

1313

14−infixr 2 |||

14+infixl 2 |||

1515

1616class BaseArrow a => ArrowChoice a where

1717 left :: a b c -> a (Either b d) (Either c d)

src/Control/Arrow/Extra/ArrowPlus.hs+1−1

@@ -5,7 +5,7 @@ where

66import Control.Arrow.Extra.ArrowZero

8−infixr 5 <+>

8+infixl 5 <+>

1010class ArrowZero a => ArrowPlus a where

1111 (<+>) :: a b c -> a b c -> a b c

src/Control/Arrow/Extra/BaseArrow.hs+15−3

@@ -2,14 +2,16 @@

33module Control.Arrow.Extra.BaseArrow

44 ( BaseArrow (..),

5+ (>>>),

6+ (<<<),

57 )

68where

8−import Control.Category

10+import Control.Category hiding ((<<<), (>>>))

911

10−infixr 3 ***

12+infixl 3 ***

1113

12−infixr 3 &&&

14+infixl 3 &&&

1315

1416class Category a => BaseArrow a where

1517 {-# MINIMAL (***), (&&&) #-}

@@ -23,3 +25,13 @@ class Category a => BaseArrow a where

2325 (***) :: a b c -> a b' c' -> a (b, b') (c, c')

2426

2527 (&&&) :: a b c -> a b c' -> a b (c, c')

28+

29+infixl 1 >>>

30+

31+(>>>) :: Category cat => cat a b -> cat b c -> cat a c

32+x >>> y = y . x

33+

34+infixl 1 <<<

35+

36+(<<<) :: Category cat => cat b c -> cat a b -> cat a c

37+x <<< y = x . y

src/Control/Arrow/Extra/PolyArrow.hs+3−4

@@ -10,13 +10,12 @@ module Control.Arrow.Extra.PolyArrow

1010where

1111

1212import Control.Arrow.Extra.BaseArrow

13−import Control.Category

1413

15−infixr 1 ^>>, >>^

14+infixl 1 ^>>, >>^

1615

17−infixr 1 ^<<, <<^

16+infixl 1 ^<<, <<^

1817

19−infixr 1 ^>^, ^<^

18+infixl 1 ^>^, ^<^

2019

2120class BaseArrow a => PolyArrow a p where

2221 arr :: p b c -> a b c

src/Control/Tuple/Morph.hs+2−2

@@ -60,7 +60,7 @@ data HList (ts :: [*]) where

6060 HCons :: t -> HList tt -> HList (t ': tt)

6161 HNil :: HList '[]

6262

63−infixr 5 :+

63+infixl 5 :+

6464

6565pattern (:+) :: (ts ~ (t : tt)) => t -> HList tt -> HList ts

6666pattern (:+) a b = HCons a b

@@ -92,7 +92,7 @@ instance (DroppableList n aa bb) => DroppableList ('S n) (a ': aa) bb where

9292

9393-- ## Appending

9494

95−infixr 4 ++:

95+infixl 4 ++:

9696

9797class AppendableList aa bb cc | aa bb -> cc where

9898 (++:) :: HList aa -> HList bb -> HList (aa ++ bb)

src/Data/Isoparsec.hs+2−2

@@ -29,12 +29,12 @@ opt :: (ArrowPlus m, PolyArrow m SemiIso) => m () () -> m () ()

2929opt m = m <+^ konst ()

3030

3131opt' :: (ArrowPlus m, PolyArrow m SemiIso, Eq a) => a -> m () a -> m () ()

32−opt' a m = (m >>^ turn (konst a)) <+^ konst ()

32+opt' a m = opt (m >>^ turn (konst a))

3333

3434repeating :: (PolyArrow m SemiIso, ArrowPlus m, Eq b) => m () b -> m () [b]

3535repeating m = (m &&& (repeating m <+^ konst [])) >>^ siCons

3636

37−infixr 0 <.>

37+infixl 0 <.>

3838

3939(<.>) ::

4040 (PolyArrow m SemiIso, TupleMorphable x c, TupleMorphable y c) =>

src/Data/Isoparsec/ByteString.hs+4−3

@@ -84,8 +84,9 @@ newtype SSHString = SSHString {unSSHString :: String}

8484

8585instance ToIsoparsec SSHString ByteString where

8686 toIsoparsec =

87− auto @(Byte32 'BE) >>> coercing @Word32

88− ^>> siPure fromIntegral fromIntegral

89− ^>> manyTokens

87+ auto @(Byte32 'BE)

88+ >>^ coercing @Word32

89+ >>^ siPure fromIntegral fromIntegral

90+ >>> manyTokens

9091 >>> utf8

9192 >>^ siPure SSHString unSSHString

src/Data/Isoparsec/Cokleisli.hs+2−4

@@ -26,10 +26,8 @@ instance (Alternative m, Monad m) => BaseArrow (Cokleisli m) where

2626 (Cokleisli cb) &&& (Cokleisli c'b) = Cokleisli $

2727 \(c, c') -> c'b c' >> cb c

2828

29−instance MonadPlus m => PolyArrow (Cokleisli m) SemiIso where

30− arr si = Cokleisli $ \t -> case project si t of

31− Just x -> return x

32− Nothing -> mzero

29+instance (Alternative m, Monad m) => PolyArrow (Cokleisli m) SemiIso where

30+ arr si = Cokleisli $ \t -> project si t

3331

3432instance MonadPlus m => ArrowZero (Cokleisli m) where

3533 zeroArrow = Cokleisli $ const mzero

src/Data/Isoparsec/Internal.hs+2−2

@@ -35,7 +35,7 @@ class

3535 tokens :: [Element s] -> m () ()

3636 default tokens :: [Element s] -> m () ()

3737 tokens [] = arr $ isoConst () ()

38− tokens (t : ts) = token t &&& tokens ts >>> arr (isoConst ((), ()) ())

38+ tokens (t : ts) = token t &&& tokens ts >>^ isoConst ((), ()) ()

3939

4040 chunk :: s -> m () ()

4141 chunk = tokens . otoList

@@ -116,4 +116,4 @@ check :: (s -> Bool) -> SemiIso s s

116116check f = isoCheck f id id

117117

118118konst :: Eq x => x -> SemiIso () x

119−konst x = SI (const $ pure x) (const $ pure ()) >>> check (== x)

119+konst x = isoConst () x >>> check (== x)

test/Spec/Megaparsec/BasicNums.hs+2−2

@@ -34,8 +34,8 @@ parser = _Foo <.> (number &&& unsafeWhiteSpace1 &&& number)

3434spec :: Spec

3535spec =

3636 it "deserializes" $ do

37− runMegaparsec @() parser "12 31" `shouldBe` (Right $ Foo 12 31)

38− runMegaparsec @() parser "1 33" `shouldBe` (Right $ Foo 1 33)

37+ runMegaparsec @() parser "12 31" `shouldBe` Right (Foo 12 31)

38+ runMegaparsec @() parser "1 33" `shouldBe` Right (Foo 1 33)

3939 runMegaparsec @() parser "1562" `shouldSatisfy` isLeft

4040

4141quickSpec :: TestTree

test/Spec/Ssh.hs+8−9

@@ -153,16 +153,15 @@ makePrisms ''Packet

153153

154154instance ToIsoparsec mac ByteString => ToIsoparsec (Packet mac) ByteString where

155155 toIsoparsec =

156− ( ( (auto @(Byte32 'BE) &&& auto @Byte8)

157− >>> (throughIntegral *** throughIntegral)

158− >>> siPure

159− (\(packetL, paddingL) -> (packetL - paddingL - 1, paddingL))

160− (\(payloadL, paddingL) -> (payloadL + paddingL + 1, paddingL))

161− ^>> (manyTokens *** throughIntegral)

162− >>> (tuck (auto @Payload) *** badZeroPadding)

163− )

164− &&& auto @mac

156+ ( auto @(Byte32 'BE) &&& auto @Byte8

157+ >>> throughIntegral *** throughIntegral

158+ >>^ siPure

159+ (\(packetL, paddingL) -> (packetL - paddingL - 1, paddingL))

160+ (\(payloadL, paddingL) -> (payloadL + paddingL + 1, paddingL))

161+ >>> manyTokens *** throughIntegral

162+ >>> tuck (auto @Payload) *** badZeroPadding

165163 )

164+ &&& auto @mac

166165 >>^ siPure (\((a, b), c) -> Packet a b c) (\(Packet a b c) -> ((a, b), c))

167166

168167spec :: Spec

test/Spec/TwoDigits.hs+3−3

@@ -25,9 +25,9 @@ newtype SingleDigit = SingleDigit {unSingleDigit :: String}

2525instance ToIsoparsec SingleDigit String where

2626 toIsoparsec =

2727 toIsoparsec @(Chunk 1 String)

28− >>> coercing

29− ^>> check (all @[] isDigit)

30− ^>^ coercing

28+ >>^ coercing

29+ >>^ check (all @[] isDigit)

30+ >>^ coercing

3131

3232instance (Arbitrary SingleDigit) where

3333 arbitrary = SingleDigit . pure <$> elements ['0' .. '9']