id 0.0.4 → 0.0.5
raw patch · 4 files changed
+64/−248 lines, 4 files
Files
- changelog.md +6/−0
- id.cabal +6/−3
- src/Data/BiId.hs +6/−9
- src/Data/Id.hs +46/−236
changelog.md view
@@ -1,3 +1,9 @@+0.0.5++* Use deriving for standard instances where possible+* Fix documentation+* Enable -Werror flag for development builds+ 0.0.4 * Add Data.BiId module with BiId p s t a b newtype and full instance coverage
id.cabal view
@@ -1,8 +1,11 @@ cabal-version: 2.4 name: id-version: 0.0.4-synopsis: Id (f a) data type-description: (f a) data type, with optics and functions for switching the type constructor (f)+version: 0.0.5+synopsis: Id (f a) and BiId (p (s a) (t b)) data types+description:+ Id (f a) and BiId (p (s a) (t b)) data types, with optics and functions for switching the type constructors+ .+ <<https://logo.systemf.com.au/systemf-450x450.jpg>> license: BSD-3-Clause license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>
src/Data/BiId.hs view
@@ -1,8 +1,11 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -102,7 +105,7 @@ -- >>> compare (BiId ([1], Identity True)) (BiId ([2], Identity False)) -- LT newtype BiId p s t a b = BiId (p (s a) (t b))- deriving (Eq, Ord, Show, Data, Generic, Generic1)+ deriving stock (Eq, Ord, Show, Data, Generic, Generic1) -- | -- >>> BiId ([1,2], [True, False]) :: Product [] [] Int Bool@@ -628,18 +631,12 @@ -- | -- >>> BiId ([1,2], [3,4]) <> BiId ([5], [6]) :: BiId (,) [] [] Int Int -- BiId ([1,2,5],[3,4,6])-instance (Semigroup (p (s a) (t b))) => Semigroup (BiId p s t a b) where- BiId x <> BiId y =- BiId (x <> y)- {-# INLINE (<>) #-}+deriving newtype instance (Semigroup (p (s a) (t b))) => Semigroup (BiId p s t a b) -- | -- >>> mempty :: BiId (,) [] [] Int Int -- BiId ([],[])-instance (Monoid (p (s a) (t b))) => Monoid (BiId p s t a b) where- mempty =- BiId mempty- {-# INLINE mempty #-}+deriving newtype instance (Monoid (p (s a) (t b))) => Monoid (BiId p s t a b) -- | -- >>> duplicated (BiId (Identity 7, Identity True))
src/Data/Id.hs view
@@ -1,8 +1,11 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}@@ -56,7 +59,7 @@ ) where -import Control.Applicative (Alternative (empty, (<|>)))+import Control.Applicative (Alternative) import Control.Comonad (Comonad (..)) import Control.DeepSeq (NFData (..), NFData1 (..)) import Control.Lens@@ -100,13 +103,13 @@ import Data.Data (Data) import Data.Distributive (Distributive (..)) import Data.Functor.Alt (Alt ((<!>)))-import Data.Functor.Apply (Apply ((<.>)))+import Data.Functor.Apply (Apply) import Data.Functor.Bind (Bind ((>>-))) import Data.Functor.Bind.Trans (BindTrans (..)) import Data.Functor.Classes ( Eq1 (..), Ord1 (..),- Show1 (liftShowsPrec),+ Show1 (..), ) import Data.Functor.Const (Const) import Data.Functor.Contravariant (Contravariant (..))@@ -117,16 +120,19 @@ import Data.Hashable (Hashable (..)) import Data.List.NonEmpty (NonEmpty) import Data.Proxy (Proxy (..))-import Data.Semigroup.Foldable (Foldable1 (foldMap1))+import Data.Semigroup.Foldable (Foldable1) import Data.Semigroup.Traversable (Traversable1 (traverse1)) import Data.Tagged (Tagged (Tagged), untag) import GHC.Generics (Generic, Generic1) -- $setup+-- >>> import Control.Applicative (empty, (<|>)) -- >>> import Control.Lens (set, preview, review, from)+-- >>> import Data.Functor.Apply ((<.>)) -- >>> import Data.Functor.Const (Const(..)) -- >>> import Data.List.NonEmpty (NonEmpty(..)) -- >>> import Data.Semigroup (Sum(..))+-- >>> import Data.Semigroup.Foldable (foldMap1) -- | -- >>> Id [1,2,3]@@ -145,8 +151,9 @@ -- True newtype Id f a = Id (f a)- deriving (Eq, Ord, Show, Data, Generic, Generic1)+ deriving stock (Eq, Ord, Show, Data, Generic, Generic1) +-- Instances derived via GeneralizedNewtypeDeriving -- | -- >>> liftEq (==) (Id [1,2,3]) (Id [1,2,3]) -- True@@ -156,10 +163,7 @@ -- -- >>> liftEq (\_ _ -> True) (Id [1,2,3]) (Id [4,5,6]) -- True-instance (Eq1 f) => Eq1 (Id f) where- liftEq f (Id x) (Id y) =- liftEq f x y- {-# INLINE liftEq #-}+deriving newtype instance (Eq1 f) => Eq1 (Id f) -- | -- >>> liftCompare compare (Id [1,2,3]) (Id [1,2,4])@@ -170,10 +174,7 @@ -- -- >>> liftCompare (\_ _ -> GT) (Id [1]) (Id [2]) -- GT-instance (Ord1 f) => Ord1 (Id f) where- liftCompare f (Id x) (Id y) =- liftCompare f x y- {-# INLINE liftCompare #-}+deriving newtype instance (Ord1 f) => Ord1 (Id f) -- | -- >>> liftShowsPrec showsPrec showList 0 (Id [1,2,3]) ""@@ -573,10 +574,7 @@ -- -- >>> Id "hello" <> Id " world" -- Id "hello world"-instance (Semigroup (f a)) => Semigroup (Id f a) where- Id x <> Id y =- Id (x <> y)- {-# INLINE (<>) #-}+deriving newtype instance (Semigroup (f a)) => Semigroup (Id f a) -- | -- >>> mempty :: Id [] Int@@ -587,10 +585,7 @@ -- -- >>> mempty <> Id [1,2] :: Id [] Int -- Id [1,2]-instance (Monoid (f a)) => Monoid (Id f a) where- mempty =- Id mempty- {-# INLINE mempty #-}+deriving newtype instance (Monoid (f a)) => Monoid (Id f a) -- | -- >>> fmap (+1) (Id [1,2,3])@@ -601,10 +596,7 @@ -- -- >>> fmap show (Id [1,2,3]) -- Id ["1","2","3"]-instance (Functor f) => Functor (Id f) where- fmap f (Id x) =- Id (fmap f x)- {-# INLINE fmap #-}+deriving newtype instance (Functor f) => Functor (Id f) -- | -- >>> Id [(+1), (*2)] <.> Id [3,4]@@ -612,10 +604,7 @@ -- -- >>> Id (Identity (+1)) <.> Id (Identity 5) -- Id (Identity 6)-instance (Apply f) => Apply (Id f) where- Id x <.> Id y =- Id (x <.> y)- {-# INLINE (<.>) #-}+deriving newtype instance (Apply f) => Apply (Id f) -- | -- >>> Id [(+1), (*2)] <*> Id [3,4]@@ -626,22 +615,7 @@ -- -- >>> pure 'x' :: Id Identity Char -- Id (Identity 'x')-instance (Applicative f) => Applicative (Id f) where- Id x <*> Id y =- Id (x <*> y)- {-# INLINE (<*>) #-}- pure =- Id . pure- {-# INLINE pure #-}- liftA2 f (Id x) (Id y) =- Id (liftA2 f x y)- {-# INLINE liftA2 #-}- Id x *> Id y =- Id (x *> y)- {-# INLINE (*>) #-}- Id x <* Id y =- Id (x <* y)- {-# INLINE (<*) #-}+deriving newtype instance (Applicative f) => Applicative (Id f) -- | -- >>> select (Id [Right 7]) (Id [const 0])@@ -652,10 +626,7 @@ -- -- >>> select (Id [Left 3, Right 7]) (Id [(+1), (*2)]) -- Id [4,6,7]-instance (Selective f) => Selective (Id f) where- select (Id x) (Id y) =- Id (select x y)- {-# INLINE select #-}+deriving newtype instance (Selective f) => Selective (Id f) -- | -- >>> Id [1,2] <!> Id [3,4]@@ -683,13 +654,7 @@ -- -- >>> empty :: Id Maybe Int -- Id Nothing-instance (Alternative f) => Alternative (Id f) where- Id x <|> Id y =- Id (x <|> y)- {-# INLINE (<|>) #-}- empty =- Id empty- {-# INLINE empty #-}+deriving newtype instance (Alternative f) => Alternative (Id f) -- | -- >>> Id [1,2,3] >>- (\x -> Id [x, x*10])@@ -722,27 +687,12 @@ -- -- >>> foldr (:) [] (Id [1,2,3]) -- [1,2,3]-instance (Foldable f) => Foldable (Id f) where- foldMap f (Id x) =- foldMap f x- {-# INLINE foldMap #-}- foldr f z (Id x) =- foldr f z x- {-# INLINE foldr #-}- null (Id x) =- null x- {-# INLINE null #-}- length (Id x) =- length x- {-# INLINE length #-}+deriving newtype instance (Foldable f) => Foldable (Id f) -- | -- >>> foldMap1 show (Id (Identity 7)) -- "7"-instance (Foldable1 f) => Foldable1 (Id f) where- foldMap1 f (Id x) =- foldMap1 f x- {-# INLINE foldMap1 #-}+deriving newtype instance (Foldable1 f) => Foldable1 (Id f) -- | -- >>> traverse Just (Id [1,2,3])@@ -769,10 +719,7 @@ -- | -- >>> unId (liftIO (pure 7) :: Id IO Int) -- 7-instance (MonadIO f) => MonadIO (Id f) where- liftIO =- Id . liftIO- {-# INLINE liftIO #-}+deriving newtype instance (MonadIO f) => MonadIO (Id f) -- | -- >>> lift [1,2,3] :: Id [] Int@@ -799,22 +746,13 @@ -- -- >>> catchError (Id (Left "oops")) (\_ -> Id (Right 42)) :: Id (Either String) Int -- Id (Right 42)-instance (MonadError a f) => MonadError a (Id f) where- throwError =- Id . throwError- {-# INLINE throwError #-}- catchError (Id x) f =- Id (catchError x (view _Wrapped . f))- {-# INLINE catchError #-}+deriving newtype instance (MonadError a f) => MonadError a (Id f) -- | -- >>> import Control.Monad.Cont (runCont) -- >>> runCont (callCC (\k -> k (Id [7]))) unId :: [Int] -- [7]-instance (MonadCont f) => MonadCont (Id f) where- callCC f =- Id (callCC (\k -> view _Wrapped (f (Id . k))))- {-# INLINE callCC #-}+deriving newtype instance (MonadCont f) => MonadCont (Id f) -- | -- >>> import Control.Monad.Reader (runReader)@@ -823,16 +761,7 @@ -- -- >>> runReader (unId (local (++" world") ask)) "hello" -- "hello world"-instance (MonadReader a f) => MonadReader a (Id f) where- ask =- Id ask- {-# INLINE ask #-}- local f (Id x) =- Id (local f x)- {-# INLINE local #-}- reader =- Id . reader- {-# INLINE reader #-}+deriving newtype instance (MonadReader a f) => MonadReader a (Id f) -- | -- >>> import Control.Monad.Writer (runWriter)@@ -841,52 +770,25 @@ -- -- >>> runWriter (unId (writer (7, "log"))) -- (7,"log")-instance (MonadWriter a f) => MonadWriter a (Id f) where- writer aw =- Id (writer aw)- {-# INLINE writer #-}- tell =- Id . tell- {-# INLINE tell #-}- listen =- over _Wrapped listen- {-# INLINE listen #-}- pass =- over _Wrapped pass- {-# INLINE pass #-}+deriving newtype instance (MonadWriter a f) => MonadWriter a (Id f) -- | -- >>> import Control.Monad.State (runState) -- >>> runState (unId (get >>= \s -> put (s + 1) >> pure s)) 10 -- (10,11)-instance (MonadState a f) => MonadState a (Id f) where- get =- Id get- {-# INLINE get #-}- put =- Id . put- {-# INLINE put #-}- state =- Id . state- {-# INLINE state #-}+deriving newtype instance (MonadState a f) => MonadState a (Id f) -instance (MonadRWS r w s f) => MonadRWS r w s (Id f)+deriving newtype instance (MonadRWS r w s f) => MonadRWS r w s (Id f) -- | -- >>> mfix (\_ -> Id [1,2,3]) -- Id [1,2,3]-instance (MonadFix f) => MonadFix (Id f) where- mfix g =- Id (mfix (unId . g))- {-# INLINE mfix #-}+deriving newtype instance (MonadFix f) => MonadFix (Id f) -- | -- >>> fail "oops" :: Id Maybe Int -- Id Nothing-instance (MonadFail f) => MonadFail (Id f) where- fail =- Id . fail- {-# INLINE fail #-}+deriving newtype instance (MonadFail f) => MonadFail (Id f) -- | -- >>> mzero :: Id [] Int@@ -894,15 +796,12 @@ -- -- >>> mplus (Id [1,2]) (Id [3,4]) -- Id [1,2,3,4]-instance (MonadPlus f) => MonadPlus (Id f)+deriving newtype instance (MonadPlus f) => MonadPlus (Id f) -- | -- >>> mzipWith (+) (Id [1,2,3]) (Id [10,20,30]) -- Id [11,22,33]-instance (MonadZip f) => MonadZip (Id f) where- mzipWith f (Id x) (Id y) =- Id (mzipWith f x y)- {-# INLINE mzipWith #-}+deriving newtype instance (MonadZip f) => MonadZip (Id f) -- | -- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)@@ -911,10 +810,7 @@ -- -- >>> getPredicate (unId (contramap length (Id (Predicate (> 3))))) "hi" -- False-instance (Contravariant f) => Contravariant (Id f) where- contramap f (Id x) =- Id (contramap f x)- {-# INLINE contramap #-}+deriving newtype instance (Contravariant f) => Contravariant (Id f) -- | -- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)@@ -924,13 +820,7 @@ -- -- >>> getPredicate (unId (divided (Id (Predicate even)) (Id (Predicate (> 0))))) (3, 1) -- False-instance (Divisible f) => Divisible (Id f) where- divide f (Id x) (Id y) =- Id (divide f x y)- {-# INLINE divide #-}- conquer =- Id conquer- {-# INLINE conquer #-}+deriving newtype instance (Divisible f) => Divisible (Id f) -- | -- >>> import Data.Functor.Contravariant (Predicate(..), getPredicate)@@ -940,21 +830,12 @@ -- -- >>> getPredicate (unId (chosen (Id (Predicate even)) (Id (Predicate (> 0))))) (Right 0) -- False-instance (Decidable f) => Decidable (Id f) where- choose f (Id x) (Id y) =- Id (choose f x y)- {-# INLINE choose #-}- lose f =- Id (lose f)- {-# INLINE lose #-}+deriving newtype instance (Decidable f) => Decidable (Id f) -- | -- >>> zero :: Id [] Int -- Id []-instance (Plus f) => Plus (Id f) where- zero =- Id zero- {-# INLINE zero #-}+deriving newtype instance (Plus f) => Plus (Id f) -- | -- >>> duplicated (Id (Identity 7))@@ -979,19 +860,13 @@ -- >>> import Control.Lens (imap) -- >>> imap (+) (Id [10,20,30]) -- Id [10,21,32]-instance (FunctorWithIndex i f) => FunctorWithIndex i (Id f) where- imap f (Id x) =- Id (imap f x)- {-# INLINE imap #-}+deriving newtype instance (FunctorWithIndex i f) => FunctorWithIndex i (Id f) -- | -- >>> import Control.Lens (ifoldMap) -- >>> ifoldMap (\i x -> [(i, x)]) (Id [10,20,30]) -- [(0,10),(1,20),(2,30)]-instance (FoldableWithIndex i f) => FoldableWithIndex i (Id f) where- ifoldMap f (Id x) =- ifoldMap f x- {-# INLINE ifoldMap #-}+deriving newtype instance (FoldableWithIndex i f) => FoldableWithIndex i (Id f) -- | -- >>> import Control.Lens (itraverse)@@ -1013,82 +888,17 @@ Id (collect ((\(Id y) -> y) . f) x) {-# INLINE collect #-} -instance (NFData (f a)) => NFData (Id f a) where- rnf (Id x) =- rnf x- {-# INLINE rnf #-}+deriving newtype instance (NFData (f a)) => NFData (Id f a) -instance (NFData1 f) => NFData1 (Id f) where- liftRnf f (Id x) =- liftRnf f x- {-# INLINE liftRnf #-}+deriving newtype instance (NFData1 f) => NFData1 (Id f) -instance (Hashable (f a)) => Hashable (Id f a) where- hashWithSalt s (Id x) =- hashWithSalt s x- {-# INLINE hashWithSalt #-}+deriving newtype instance (Hashable (f a)) => Hashable (Id f a) -instance (Num (f a)) => Num (Id f a) where- Id x + Id y = Id (x + y)- {-# INLINE (+) #-}- Id x * Id y = Id (x * y)- {-# INLINE (*) #-}- Id x - Id y = Id (x - y)- {-# INLINE (-) #-}- negate (Id x) = Id (negate x)- {-# INLINE negate #-}- abs (Id x) = Id (abs x)- {-# INLINE abs #-}- signum (Id x) = Id (signum x)- {-# INLINE signum #-}- fromInteger = Id . fromInteger- {-# INLINE fromInteger #-}+deriving newtype instance (Num (f a)) => Num (Id f a) -instance (Fractional (f a)) => Fractional (Id f a) where- Id x / Id y = Id (x / y)- {-# INLINE (/) #-}- recip (Id x) = Id (recip x)- {-# INLINE recip #-}- fromRational = Id . fromRational- {-# INLINE fromRational #-}+deriving newtype instance (Fractional (f a)) => Fractional (Id f a) -instance (Floating (f a)) => Floating (Id f a) where- pi = Id pi- {-# INLINE pi #-}- exp (Id x) = Id (exp x)- {-# INLINE exp #-}- log (Id x) = Id (log x)- {-# INLINE log #-}- sqrt (Id x) = Id (sqrt x)- {-# INLINE sqrt #-}- Id x ** Id y = Id (x ** y)- {-# INLINE (**) #-}- logBase (Id x) (Id y) = Id (logBase x y)- {-# INLINE logBase #-}- sin (Id x) = Id (sin x)- {-# INLINE sin #-}- cos (Id x) = Id (cos x)- {-# INLINE cos #-}- tan (Id x) = Id (tan x)- {-# INLINE tan #-}- asin (Id x) = Id (asin x)- {-# INLINE asin #-}- acos (Id x) = Id (acos x)- {-# INLINE acos #-}- atan (Id x) = Id (atan x)- {-# INLINE atan #-}- sinh (Id x) = Id (sinh x)- {-# INLINE sinh #-}- cosh (Id x) = Id (cosh x)- {-# INLINE cosh #-}- tanh (Id x) = Id (tanh x)- {-# INLINE tanh #-}- asinh (Id x) = Id (asinh x)- {-# INLINE asinh #-}- acosh (Id x) = Id (acosh x)- {-# INLINE acosh #-}- atanh (Id x) = Id (atanh x)- {-# INLINE atanh #-}+deriving newtype instance (Floating (f a)) => Floating (Id f a) -- | -- >>> let x = Id Proxy :: IdProxy Int in x