Fix linting and formatting

This commit is contained in:
Taylor Fausak 2021-04-18 11:28:02 -04:00
parent 3bae76975e
commit 1b9a59e9d7
3 changed files with 51 additions and 48 deletions

View File

@ -148,8 +148,9 @@ instance TryCast.TryCast Int.Int32 Natural.Natural where
tryCast = maybeTryCast fromNonNegativeIntegral
instance TryCast.TryCast Int.Int32 Float where
tryCast = maybeTryCast $ \s ->
if -maxFloat <= s && s <= maxFloat then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast $ \s -> if -maxFloat <= s && s <= maxFloat
then Just $ fromIntegral s
else Nothing
instance Cast.Cast Int.Int32 Double where
cast = fromIntegral
@ -190,14 +191,14 @@ instance TryCast.TryCast Int.Int64 Natural.Natural where
tryCast = maybeTryCast fromNonNegativeIntegral
instance TryCast.TryCast Int.Int64 Float where
tryCast = maybeTryCast $ \s ->
if -maxFloat <= s && s <= maxFloat then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast $ \s -> if -maxFloat <= s && s <= maxFloat
then Just $ fromIntegral s
else Nothing
instance TryCast.TryCast Int.Int64 Double where
tryCast = maybeTryCast $ \s ->
if -maxDouble <= s && s <= maxDouble
then Just $ fromIntegral s
else Nothing
tryCast = maybeTryCast $ \s -> if -maxDouble <= s && s <= maxDouble
then Just $ fromIntegral s
else Nothing
-- Int
@ -235,16 +236,16 @@ instance TryCast.TryCast Int Natural.Natural where
tryCast = maybeTryCast fromNonNegativeIntegral
instance TryCast.TryCast Int Float where
tryCast = maybeTryCast $ \s ->
if -maxFloat <= s && s <= maxFloat then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast $ \s -> if -maxFloat <= s && s <= maxFloat
then Just $ fromIntegral s
else Nothing
instance TryCast.TryCast Int Double where
tryCast = maybeTryCast $ \s ->
if toInteger (maxBound :: Int) <= maxDouble
if (toInteger (maxBound :: Int) <= maxDouble)
|| (-maxDouble <= s && s <= maxDouble)
then Just $ fromIntegral s
else if -maxDouble <= s && s <= maxDouble
then Just $ fromIntegral s
else Nothing
else Nothing
-- Integer
@ -287,14 +288,14 @@ instance TryCast.TryCast Integer Natural.Natural where
maybeTryCast $ \s -> if s < 0 then Nothing else Just $ fromInteger s
instance TryCast.TryCast Integer Float where
tryCast = maybeTryCast $ \s ->
if -maxFloat <= s && s <= maxFloat then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast $ \s -> if -maxFloat <= s && s <= maxFloat
then Just $ fromIntegral s
else Nothing
instance TryCast.TryCast Integer Double where
tryCast = maybeTryCast $ \s ->
if -maxDouble <= s && s <= maxDouble
then Just $ fromIntegral s
else Nothing
tryCast = maybeTryCast $ \s -> if -maxDouble <= s && s <= maxDouble
then Just $ fromIntegral s
else Nothing
-- Word8
@ -414,8 +415,8 @@ instance Cast.Cast Word.Word32 Integer where
cast = fromIntegral
instance TryCast.TryCast Word.Word32 Float where
tryCast = maybeTryCast $ \s ->
if s <= maxFloat then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast
$ \s -> if s <= maxFloat then Just $ fromIntegral s else Nothing
instance Cast.Cast Word.Word32 Double where
cast = fromIntegral
@ -456,12 +457,12 @@ instance Cast.Cast Word.Word64 Integer where
cast = fromIntegral
instance TryCast.TryCast Word.Word64 Float where
tryCast = maybeTryCast $ \s ->
if s <= maxFloat then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast
$ \s -> if s <= maxFloat then Just $ fromIntegral s else Nothing
instance TryCast.TryCast Word.Word64 Double where
tryCast = maybeTryCast $ \s ->
if s <= maxDouble then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast
$ \s -> if s <= maxDouble then Just $ fromIntegral s else Nothing
-- Word
@ -499,14 +500,14 @@ instance Cast.Cast Word Integer where
cast = fromIntegral
instance TryCast.TryCast Word Float where
tryCast = maybeTryCast $ \s ->
if s <= maxFloat then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast
$ \s -> if s <= maxFloat then Just $ fromIntegral s else Nothing
instance TryCast.TryCast Word Double where
tryCast = maybeTryCast $ \s ->
if toInteger (maxBound :: Word) <= maxDouble
if (toInteger (maxBound :: Word) <= maxDouble) || (s <= maxDouble)
then Just $ fromIntegral s
else if s <= maxDouble then Just $ fromIntegral s else Nothing
else Nothing
-- Natural
@ -544,12 +545,12 @@ instance Cast.Cast Natural.Natural Integer where
cast = fromIntegral
instance TryCast.TryCast Natural.Natural Float where
tryCast = maybeTryCast $ \s ->
if s <= maxFloat then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast
$ \s -> if s <= maxFloat then Just $ fromIntegral s else Nothing
instance TryCast.TryCast Natural.Natural Double where
tryCast = maybeTryCast $ \s ->
if s <= maxDouble then Just $ fromIntegral s else Nothing
tryCast = maybeTryCast
$ \s -> if s <= maxDouble then Just $ fromIntegral s else Nothing
-- Float
@ -594,8 +595,8 @@ instance TryCast.TryCast Float Natural.Natural where
tryCast = tryCastVia @Integer
instance TryCast.TryCast Float Rational where
tryCast = maybeTryCast $ \s ->
if isNaN s || isInfinite s then Nothing else Just $ toRational s
tryCast = maybeTryCast
$ \s -> if isNaN s || isInfinite s then Nothing else Just $ toRational s
instance Cast.Cast Float Double where
cast = realToFrac
@ -643,8 +644,8 @@ instance TryCast.TryCast Double Natural.Natural where
tryCast = tryCastVia @Integer
instance TryCast.TryCast Double Rational where
tryCast = maybeTryCast $ \s ->
if isNaN s || isInfinite s then Nothing else Just $ toRational s
tryCast = maybeTryCast
$ \s -> if isNaN s || isInfinite s then Nothing else Just $ toRational s
instance Cast.Cast Double Float where
cast = realToFrac
@ -798,7 +799,7 @@ maybeTryCast f s = case f s of
tryCastVia
:: forall through source target
. (TryCast.TryCast source through, TryCast.TryCast through target)
. (TryCast.TryCast source through, TryCast.TryCast through target)
=> source
-> Either (TryCastException.TryCastException source target) target
tryCastVia s = case TryCast.tryCast s of

View File

@ -15,11 +15,13 @@ instance
, Typeable.Typeable source
, Typeable.Typeable target
) => Show (TryCastException source target) where
showsPrec d (TryCastException x) = showParen (d > 10)
$ showString "TryCastException {- "
. shows (Typeable.typeRep (Proxy.Proxy :: Proxy.Proxy (source -> target)))
. showString " -} "
. showsPrec 11 x
showsPrec d (TryCastException x) =
showParen (d > 10)
$ showString "TryCastException {- "
. shows
(Typeable.typeRep (Proxy.Proxy :: Proxy.Proxy (source -> target)))
. showString " -} "
. showsPrec 11 x
instance
( Show source

View File

@ -24,7 +24,7 @@ import qualified Data.Text.Lazy as LazyText
import qualified Data.Word as Word
import qualified Numeric.Natural as Natural
import qualified Test.Hspec as Hspec
import qualified Witch as Witch
import qualified Witch
main :: IO ()
main = Hspec.hspec . Hspec.describe "Witch" $ do
@ -82,7 +82,7 @@ main = Hspec.hspec . Hspec.describe "Witch" $ do
test $ ($$(Witch.liftedFrom @Int.Int16 1) :: Int.Int8) `Hspec.shouldBe` 1
Hspec.describe "liftedInto" $ do
test $ ($$(Witch.liftedInto @Int.Int8 (1 :: Int.Int16))) `Hspec.shouldBe` 1
test $ $$(Witch.liftedInto @Int.Int8 (1 :: Int.Int16)) `Hspec.shouldBe` 1
Hspec.describe "Instances" $ do
@ -1463,14 +1463,14 @@ main = Hspec.hspec . Hspec.describe "Witch" $ do
Hspec.describe "Cast [(k, v)] (Map k v)" $ do
let f = Witch.cast @[(Char, Int)] @(Map.Map Char Int)
test $ f [] `Hspec.shouldBe` Map.fromList []
test $ f [] `Hspec.shouldBe` Map.empty
test $ f [('a', 1)] `Hspec.shouldBe` Map.fromList [('a', 1)]
test $ f [('a', 1), ('b', 2)] `Hspec.shouldBe` Map.fromList [('a', 1), ('b', 2)]
test $ f [('a', 1), ('a', 2)] `Hspec.shouldBe` Map.fromList [('a', 2)]
Hspec.describe "Cast (Map k v) [(k, v)]" $ do
let f = Witch.cast @(Map.Map Char Int) @[(Char, Int)]
test $ f (Map.fromList []) `Hspec.shouldBe` []
test $ f Map.empty `Hspec.shouldBe` []
test $ f (Map.fromList [('a', 1)]) `Hspec.shouldBe` [('a', 1)]
test $ f (Map.fromList [('a', 1), ('b', 2)]) `Hspec.shouldBe` [('a', 1), ('b', 2)]