Skip to content

Commit fbb2dbb

Browse files
bezirgbezirg
committed
fourmolu
1 parent 354ac37 commit fbb2dbb

File tree

9 files changed

+126
-124
lines changed

9 files changed

+126
-124
lines changed

‎plutus-tx/src/PlutusTx/Eq.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,10 @@
33

44
module PlutusTx.Eq (Eq (..), (/=), deriveEq) where
55

6-
import PlutusTx.Eq.Class
7-
import PlutusTx.Eq.TH
86
import PlutusTx.Bool
97
import PlutusTx.Either (Either (..))
8+
import PlutusTx.Eq.Class
9+
import PlutusTx.Eq.TH
1010
import Prelude (Maybe (..), Ordering (..))
1111

1212
deriveEq ''[]

‎plutus-tx/src/PlutusTx/Eq/Class.hs‎

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
module PlutusTx.Eq.Class
2-
( Eq(..)
2+
( Eq (..)
33
, (/=)
44
) where
55

@@ -8,16 +8,15 @@ import PlutusTx.Builtins qualified as Builtins
88

99
infix 4 ==
1010

11-
{- | The 'Eq' class defines equality ('==').
11+
{-| The 'Eq' class defines equality ('==').
1212
1313
(/=) deliberately omitted, to make this a one-method class which has a
14-
simpler representation
15-
-}
14+
simpler representation -}
1615
class Eq a where
1716
(==) :: a -> a -> Bool
1817

1918
infix 4 /=
20-
(/=) :: (Eq a) => a -> a -> Bool
19+
(/=) :: Eq a => a -> a -> Bool
2120
x /= y = not (x == y)
2221
{-# INLINEABLE (/=) #-}
2322

‎plutus-tx/src/PlutusTx/Eq/TH.hs‎

Lines changed: 35 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,19 @@
11
{-# LANGUAGE TemplateHaskellQuotes #-}
2+
23
module PlutusTx.Eq.TH (Eq (..), deriveEq) where
34

4-
import PlutusTx.Eq.Class
5-
import PlutusTx.Bool ((&&), Bool (True))
6-
import Prelude hiding (Eq, (==), (&&), Bool (True))
5+
import Data.Deriving.Internal (varTToName)
76
import Data.Foldable
87
import Data.Traversable
98
import Language.Haskell.TH as TH
109
import Language.Haskell.TH.Datatype as TH
11-
import Data.Deriving.Internal (varTToName)
10+
import PlutusTx.Bool (Bool (True), (&&))
11+
import PlutusTx.Eq.Class
12+
import Prelude hiding (Bool (True), Eq, (&&), (==))
1213

13-
{- | derive a PlutusTx.Eq instance for a datatype/newtype, similar to Haskell's `deriving stock Eq`.
14+
{-| derive a PlutusTx.Eq instance for a datatype/newtype, similar to Haskell's `deriving stock Eq`.
1415
15-
One shortcoming compared to Haskell's deriving is that you cannot `PlutusTx.deriveEq` for polymorphic phantom types.
16-
-}
16+
One shortcoming compared to Haskell's deriving is that you cannot `PlutusTx.deriveEq` for polymorphic phantom types. -}
1717
deriveEq :: TH.Name -> TH.Q [TH.Dec]
1818
deriveEq name = do
1919
TH.DatatypeInfo
@@ -32,29 +32,37 @@ deriveEq name = do
3232
instanceType :: TH.Type
3333
instanceType = TH.AppT (TH.ConT ''Eq) $ foldl' TH.AppT (TH.ConT tyConName) tyVars
3434

35-
pure <$> instanceD (pure instanceCxt) (pure instanceType)
36-
[funD '(==) (fmap deriveEqCons cons <> [pure eqDefaultClause])
37-
, TH.pragInlD '(==) TH.Inlinable TH.FunLike TH.AllPhases
38-
]
39-
35+
pure
36+
<$> instanceD
37+
(pure instanceCxt)
38+
(pure instanceType)
39+
[ funD '(==) (fmap deriveEqCons cons <> [pure eqDefaultClause])
40+
, TH.pragInlD '(==) TH.Inlinable TH.FunLike TH.AllPhases
41+
]
4042

4143
-- Clause: Cons1 l1 l2 l3 .. ln == Cons1 r1 r2 r3 .. rn
4244
deriveEqCons :: ConstructorInfo -> Q Clause
43-
deriveEqCons (ConstructorInfo {constructorName = name, constructorFields = fields })
44-
= do
45-
argsL <- for [1 .. length fields] $ \i -> TH.newName ("l" <> show i <> "l")
46-
argsR <- for [1 .. length fields] $ \i -> TH.newName ("r" <> show i <> "r")
47-
pure (TH.Clause [ConP name [] (fmap VarP argsL), ConP name [] (fmap VarP argsR)]
48-
(NormalB $
49-
case fields of
50-
[] -> TH.ConE 'True
51-
_ -> foldr1 (\ e acc -> TH.InfixE (pure e) (TH.VarE '(&&)) (pure acc))
52-
$ zipWith (\ argL argR ->
53-
TH.InfixE (pure $ TH.VarE argL) (TH.VarE '(==)) (pure $ TH.VarE argR)
54-
) argsL argsR
55-
)
56-
[]
57-
)
45+
deriveEqCons (ConstructorInfo {constructorName = name, constructorFields = fields}) =
46+
do
47+
argsL <- for [1 .. length fields] $ \i -> TH.newName ("l" <> show i <> "l")
48+
argsR <- for [1 .. length fields] $ \i -> TH.newName ("r" <> show i <> "r")
49+
pure
50+
( TH.Clause
51+
[ConP name [] (fmap VarP argsL), ConP name [] (fmap VarP argsR)]
52+
( NormalB $
53+
case fields of
54+
[] -> TH.ConE 'True
55+
_ ->
56+
foldr1 (\e acc -> TH.InfixE (pure e) (TH.VarE '(&&)) (pure acc)) $
57+
zipWith
58+
( \argL argR ->
59+
TH.InfixE (pure $ TH.VarE argL) (TH.VarE '(==)) (pure $ TH.VarE argR)
60+
)
61+
argsL
62+
argsR
63+
)
64+
[]
65+
)
5866

5967
-- Clause: _ == _ = False
6068
eqDefaultClause :: Clause

‎plutus-tx/src/PlutusTx/Functor.hs‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
{-# LANGUAGE InstanceSigs #-}
2-
{-# LANGUAGE LambdaCase #-}
2+
{-# LANGUAGE LambdaCase #-}
33

44
module PlutusTx.Functor (Functor (..), (<$>), (<&>), (<$)) where
55

@@ -24,41 +24,41 @@ class Functor f where
2424
infixl 4 <$>
2525

2626
-- | Plutus Tx version of '(Data.Functor.<$>)'.
27-
(<$>) :: (Functor f) => (a -> b) -> f a -> f b
27+
(<$>) :: Functor f => (a -> b) -> f a -> f b
2828
(<$>) = fmap
2929
{-# INLINEABLE (<$>) #-}
3030

3131
infixl 1 <&>
3232

3333
-- | Plutus Tx version of '(Data.Functor.<&>)'.
34-
(<&>) :: (Functor f) => f a -> (a -> b) -> f b
34+
(<&>) :: Functor f => f a -> (a -> b) -> f b
3535
as <&> f = f <$> as
3636
{-# INLINEABLE (<&>) #-}
3737

3838
infixl 4 <$
3939

4040
-- | Plutus Tx version of '(Data.Functor.<$)'.
41-
(<$) :: (Functor f) => a -> f b -> f a
41+
(<$) :: Functor f => a -> f b -> f a
4242
(<$) a = fmap (const a)
4343
{-# INLINEABLE (<$) #-}
4444

4545
instance Functor [] where
4646
{-# INLINEABLE fmap #-}
4747
fmap f = go
48-
where
49-
go = \case
50-
[] -> []
51-
x : xs -> f x : go xs
48+
where
49+
go = \case
50+
[] -> []
51+
x : xs -> f x : go xs
5252

5353
instance Functor Maybe where
5454
{-# INLINEABLE fmap #-}
5555
fmap f (Just a) = Just (f a)
56-
fmap _ Nothing = Nothing
56+
fmap _ Nothing = Nothing
5757

5858
instance Functor (Either c) where
5959
{-# INLINEABLE fmap #-}
6060
fmap f (Right a) = Right (f a)
61-
fmap _ (Left c) = Left c
61+
fmap _ (Left c) = Left c
6262

6363
instance Functor ((,) c) where
6464
{-# INLINEABLE fmap #-}

‎plutus-tx/src/PlutusTx/Ord.hs‎

Lines changed: 14 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -21,9 +21,8 @@ infix 4 <, <=, >, >=
2121
{-| The 'Ord' class is used for totally ordered datatypes.
2222
2323
Minimal complete definition: either 'compare' or '<='.
24-
Using 'compare' can be more efficient for complex types.
25-
-}
26-
class (Eq a) => Ord a where
24+
Using 'compare' can be more efficient for complex types. -}
25+
class Eq a => Ord a where
2726
compare :: a -> a -> Ordering
2827
(<), (<=), (>), (>=) :: a -> a -> Bool
2928
max, min :: a -> a -> a
@@ -77,38 +76,38 @@ instance Ord Builtins.BuiltinByteString where
7776
{-# INLINEABLE (>=) #-}
7877
(>=) = Builtins.greaterThanEqualsByteString
7978

80-
instance (Ord a) => Ord [a] where
79+
instance Ord a => Ord [a] where
8180
{-# INLINEABLE compare #-}
8281
compare [] [] = EQ
8382
compare [] (_ : _) = LT
8483
compare (_ : _) [] = GT
8584
compare (x : xs) (y : ys) =
8685
case compare x y of
8786
EQ -> compare xs ys
88-
c -> c
87+
c -> c
8988

9089
instance Ord Bool where
9190
{-# INLINEABLE compare #-}
9291
compare b1 b2 = case b1 of
9392
False -> case b2 of
9493
False -> EQ
95-
True -> LT
94+
True -> LT
9695
True -> case b2 of
9796
False -> GT
98-
True -> EQ
97+
True -> EQ
9998

100-
instance (Ord a) => Ord (Maybe a) where
99+
instance Ord a => Ord (Maybe a) where
101100
{-# INLINEABLE compare #-}
102101
compare (Just a1) (Just a2) = compare a1 a2
103-
compare Nothing (Just _) = LT
104-
compare (Just _) Nothing = GT
105-
compare Nothing Nothing = EQ
102+
compare Nothing (Just _) = LT
103+
compare (Just _) Nothing = GT
104+
compare Nothing Nothing = EQ
106105

107106
instance (Ord a, Ord b) => Ord (Either a b) where
108107
{-# INLINEABLE compare #-}
109-
compare (Left a1) (Left a2) = compare a1 a2
110-
compare (Left _) (Right _) = LT
111-
compare (Right _) (Left _) = GT
108+
compare (Left a1) (Left a2) = compare a1 a2
109+
compare (Left _) (Right _) = LT
110+
compare (Right _) (Left _) = GT
112111
compare (Right b1) (Right b2) = compare b1 b2
113112

114113
instance Ord () where
@@ -120,4 +119,4 @@ instance (Ord a, Ord b) => Ord (a, b) where
120119
compare (a, b) (a', b') =
121120
case compare a a' of
122121
EQ -> compare b b'
123-
c -> c
122+
c -> c

‎plutus-tx/src/PlutusTx/Sqrt.hs‎

Lines changed: 29 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,18 @@
1-
{-# LANGUAGE DeriveAnyClass #-}
2-
{-# LANGUAGE DeriveGeneric #-}
3-
{-# LANGUAGE DerivingStrategies #-}
4-
{-# LANGUAGE FlexibleContexts #-}
5-
{-# LANGUAGE FlexibleInstances #-}
1+
{-# LANGUAGE DeriveAnyClass #-}
2+
{-# LANGUAGE DeriveGeneric #-}
3+
{-# LANGUAGE DerivingStrategies #-}
4+
{-# LANGUAGE FlexibleContexts #-}
5+
{-# LANGUAGE FlexibleInstances #-}
66
{-# LANGUAGE MultiParamTypeClasses #-}
7-
{-# LANGUAGE TemplateHaskell #-}
8-
{-# LANGUAGE ViewPatterns #-}
7+
{-# LANGUAGE TemplateHaskell #-}
8+
{-# LANGUAGE ViewPatterns #-}
99
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:context-level=3 #-}
1010

11-
module PlutusTx.Sqrt (
12-
Sqrt (..),
13-
rsqrt,
14-
isqrt,
15-
) where
11+
module PlutusTx.Sqrt
12+
( Sqrt (..)
13+
, rsqrt
14+
, isqrt
15+
) where
1616

1717
import PlutusTx.IsData (makeIsDataIndexed)
1818
import PlutusTx.Lift (makeLift)
@@ -23,20 +23,17 @@ import Prelude qualified as Haskell
2323
-- | Integer square-root representation, discarding imaginary integers.
2424
data Sqrt
2525
= {-| The number was negative, so we don't even attempt to compute it;
26-
just note that the result would be imaginary.
27-
-}
26+
just note that the result would be imaginary. -}
2827
Imaginary
2928
| -- | An exact integer result. The 'rsqrt' of 4 is 'Exactly 2'.
3029
Exactly Integer
3130
| {-| The Integer component (i.e. the floor) of a non-integral result. The
32-
'rsqrt 2' is 'Approximately 1'.
33-
-}
31+
'rsqrt 2' is 'Approximately 1'. -}
3432
Approximately Integer
3533
deriving stock (Haskell.Show, Haskell.Eq)
3634

3735
{-| Calculates the sqrt of a ratio of integers. As x / 0 is undefined,
38-
calling this function with `d=0` results in an error.
39-
-}
36+
calling this function with `d=0` results in an error. -}
4037
rsqrt :: Rational -> Sqrt
4138
rsqrt r
4239
| n * d < 0 = Imaginary
@@ -45,20 +42,20 @@ rsqrt r
4542
| n < d = Approximately 0
4643
| n < 0 = rsqrt $ unsafeRatio (negate n) (negate d)
4744
| otherwise = go 1 $ 1 + divide n d
48-
where
49-
n = numerator r
50-
d = denominator r
51-
go :: Integer -> Integer -> Sqrt
52-
go l u
53-
| l * l * d == n = Exactly l
54-
| u == (l + 1) = Approximately l
55-
| otherwise =
56-
let
57-
m = divide (l + u) 2
58-
in
59-
if m * m * d <= n
60-
then go m u
61-
else go l m
45+
where
46+
n = numerator r
47+
d = denominator r
48+
go :: Integer -> Integer -> Sqrt
49+
go l u
50+
| l * l * d == n = Exactly l
51+
| u == (l + 1) = Approximately l
52+
| otherwise =
53+
let
54+
m = divide (l + u) 2
55+
in
56+
if m * m * d <= n
57+
then go m u
58+
else go l m
6259
{-# INLINEABLE rsqrt #-}
6360

6461
-- | Calculates the integer-component of the sqrt of 'n'.

‎plutus-tx/src/PlutusTx/Trace.hs‎

Lines changed: 8 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
1-
module PlutusTx.Trace (
2-
trace,
3-
traceError,
4-
traceIfFalse,
5-
traceIfTrue,
6-
traceBool,
7-
) where
1+
module PlutusTx.Trace
2+
( trace
3+
, traceError
4+
, traceIfFalse
5+
, traceIfTrue
6+
, traceBool
7+
) where
88

99
import PlutusTx.Bool
1010
import PlutusTx.Builtins as Builtins
@@ -25,8 +25,7 @@ traceIfTrue str a = if a then trace str True else False
2525
{-# INLINEABLE traceIfTrue #-}
2626

2727
{-| Emit one of two 'BuiltinString' depending on whether or not the argument
28-
evaluates to 'True' or 'False'.
29-
-}
28+
evaluates to 'True' or 'False'. -}
3029
traceBool :: BuiltinString -> BuiltinString -> Bool -> Bool
3130
traceBool trueLabel falseLabel c = if c then trace trueLabel True else trace falseLabel False
3231
{-# INLINEABLE traceBool #-}

0 commit comments

Comments
 (0)