mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-12-27 13:43:28 +03:00
117 lines
2.8 KiB
Idris
117 lines
2.8 KiB
Idris
module Control.Applicative.Const
|
|
|
|
import Data.Contravariant
|
|
import Data.Bits
|
|
|
|
%default total
|
|
|
|
public export
|
|
record Const (a : Type) (b : Type) where
|
|
constructor MkConst
|
|
runConst : a
|
|
|
|
public export
|
|
Eq a => Eq (Const a b) where
|
|
(==) = (==) `on` runConst
|
|
|
|
public export
|
|
Ord a => Ord (Const a b) where
|
|
compare = compare `on` runConst
|
|
|
|
export
|
|
Show a => Show (Const a b) where
|
|
showPrec p (MkConst v) = showCon p "MkConst" (showArg v)
|
|
|
|
public export
|
|
Semigroup a => Semigroup (Const a b) where
|
|
MkConst x <+> MkConst y = MkConst (x <+> y)
|
|
|
|
public export
|
|
Monoid a => Monoid (Const a b) where
|
|
neutral = MkConst neutral
|
|
|
|
public export
|
|
Num a => Num (Const a b) where
|
|
MkConst x + MkConst y = MkConst (x + y)
|
|
MkConst x * MkConst y = MkConst (x * y)
|
|
fromInteger = MkConst . fromInteger
|
|
|
|
public export
|
|
Neg a => Neg (Const a b) where
|
|
negate (MkConst x) = MkConst (negate x)
|
|
MkConst x - MkConst y = MkConst (x - y)
|
|
|
|
public export
|
|
Abs a => Abs (Const a b) where
|
|
abs (MkConst x) = MkConst (abs x)
|
|
|
|
public export
|
|
Fractional a => Fractional (Const a b) where
|
|
recip (MkConst x) = MkConst (recip x)
|
|
MkConst x / MkConst y = MkConst (x / y)
|
|
|
|
public export
|
|
Integral a => Integral (Const a b) where
|
|
MkConst x `div` MkConst y = MkConst (x `div` y)
|
|
MkConst x `mod` MkConst y = MkConst (x `mod` y)
|
|
|
|
public export
|
|
Bits a => Bits (Const a b) where
|
|
Index = Index {a}
|
|
MkConst x .&. MkConst y = MkConst (x .&. y)
|
|
MkConst x .|. MkConst y = MkConst (x .|. y)
|
|
MkConst x `xor` MkConst y = MkConst (x `xor` y)
|
|
shiftL (MkConst v) ix = MkConst (shiftL v ix)
|
|
shiftR (MkConst v) ix = MkConst (shiftR v ix)
|
|
bit = MkConst . bit
|
|
zeroBits = MkConst zeroBits
|
|
complement (MkConst v) = MkConst (complement v)
|
|
oneBits = MkConst oneBits
|
|
complementBit (MkConst v) ix = MkConst (complementBit v ix)
|
|
clearBit (MkConst v) ix = MkConst (clearBit v ix)
|
|
testBit (MkConst v) ix = testBit v ix
|
|
setBit (MkConst v) ix = MkConst (setBit v ix)
|
|
|
|
public export
|
|
FromString a => FromString (Const a b) where
|
|
fromString = MkConst . fromString
|
|
|
|
public export
|
|
Functor (Const a) where
|
|
map _ (MkConst v) = MkConst v
|
|
|
|
public export
|
|
Contravariant (Const a) where
|
|
contramap _ (MkConst v) = MkConst v
|
|
|
|
public export
|
|
Monoid a => Applicative (Const a) where
|
|
pure _ = MkConst neutral
|
|
MkConst x <*> MkConst y = MkConst (x <+> y)
|
|
|
|
public export
|
|
Foldable (Const a) where
|
|
foldr _ acc _ = acc
|
|
foldl _ acc _ = acc
|
|
null _ = True
|
|
toList _ = []
|
|
foldMap _ _ = neutral
|
|
|
|
public export
|
|
Traversable (Const a) where
|
|
traverse _ (MkConst v) = pure (MkConst v)
|
|
|
|
public export
|
|
Bifunctor Const where
|
|
bimap f _ (MkConst v) = MkConst (f v)
|
|
|
|
public export
|
|
Bifoldable Const where
|
|
bifoldr f _ acc (MkConst v) = f v acc
|
|
bifoldl f _ acc (MkConst v) = f acc v
|
|
binull _ = False
|
|
|
|
public export
|
|
Bitraversable Const where
|
|
bitraverse f _ (MkConst v) = MkConst <$> f v
|