one-liner-instances 0.1.1.0 → 0.1.2.0

raw patch · 9 files changed

+366/−77 lines, 9 filesdep +randomPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: random

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +4/−3
• one-liner-instances.cabal +6/−6
• src/Data/Bounded/OneLiner.hs +3/−3
• src/Data/Monoid/OneLiner.hs +4/−4
• src/Data/Ord/OneLiner.hs +10/−10
• src/Generics/OneLiner/Instances/Internal.hs +0/−22
• src/Numeric/OneLiner.hs +29/−29
• src/System/Random/OneLiner.hs +301/−0

@@ -1,6 +1,15 @@ Changelog ========= +Version 0.1.2.0+---------------++*Apr 20, 2018*++<https://github.com/mstksg/one-liner-instances/releases/tag/v0.1.2.0>++*   Generic instances for `Random` from the *random* package.+ Version 0.1.1.0 --------------- 

@@ -3,11 +3,12 @@  This package uses machinery from *[one-liner][]* in order to provide default implementations for methods from `Num`, `Fractional`, `Floating`, `Semigroup`,-`Monoid`, `Bounded`, `Eq`, and `Ord`.  These will work for any types (deriving-`Generic`) whose fields are all instances of that typeclass.+`Monoid`, `Bounded`, `Eq`, `Ord`, and `Random`.  These will work for any types+(deriving `Generic`) whose fields are all instances of that typeclass.  For `Num`, `Fractional`, `Floating`, `Semigroup`, and `Monoid`, the types also-must have only a single constructor.+must have only a single constructor.  `Random` methods offer variants with+single constructors (for performance) and with multiple constructors.  [one-liner]: https://hackage.haskell.org/package/one-liner 

@@ -1,15 +1,14 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.21.2. -- -- see: https://github.com/sol/hpack ----- hash: 95c2f55c56790e15fd9320018faf309e137158787294ce8fa8024dde4348a9fa+-- hash: a1781911abc3fd4d6382fa43927d49aba4d1e07d876833a215fc311dec1da55b  name:           one-liner-instances-version:        0.1.1.0+version:        0.1.2.0 synopsis:       Generics-based implementations for common typeclasses description:    Provides generics-based implementations for common typeclasses using-                Generics.  For now, has implementations for Numeric typeclasses (Num,-                Fractional, and Floating) and Semigroup and Monoid.+                Generics.                 .                 Please see the README on Github at <https://github.com/mstksg/one-liner-instances#readme> category:       Web@@ -38,12 +37,13 @@   build-depends:       base >=4.7 && <5     , one-liner >=0.9+    , random   exposed-modules:       Data.Bounded.OneLiner       Data.Monoid.OneLiner       Data.Ord.OneLiner       Numeric.OneLiner   other-modules:-      Generics.OneLiner.Instances.Internal+      System.Random.OneLiner       Paths_one_liner_instances   default-language: Haskell2010

@@ -36,10 +36,10 @@   , gMaxBound   ) where +import           Data.Coerce import           Data.Data import           GHC.Generics import           Generics.OneLiner-import           Generics.OneLiner.Instances.Internal  -- | If @a@ is a data type whose fields are all instances of 'Bounded', -- then @'GBounded' a@ has a 'Bounded' instance.@@ -54,9 +54,9 @@          , Constraints a Bounded          )       => Bounded (GBounded a) where-    minBound = c0 (gMinBound @a)+    minBound = coerce (gMinBound @a)     {-# INLINE minBound #-}-    maxBound = c0 (gMaxBound @a)+    maxBound = coerce (gMaxBound @a)     {-# INLINE maxBound #-}  -- | 'minBound' implemented by using 'minBound' for all of the components

@@ -40,11 +40,11 @@   , gMempty   ) where +import           Data.Coerce import           Data.Data import           Data.Semigroup import           GHC.Generics import           Generics.OneLiner-import           Generics.OneLiner.Instances.Internal  -- | If @a@ is a data type with a single constructor whose fields are all -- instances of 'Semigroup', then @'GMonoid' a@ has a 'Semigroup' instance.@@ -62,7 +62,7 @@          , Constraints a Semigroup          )       => Semigroup (GMonoid a) where-    (<>) = c2 (gSemigroup @a)+    (<>) = coerce (gSemigroup @a)     {-# INLINE (<>) #-}  instance ( ADTRecord a@@ -70,9 +70,9 @@          , Constraints a Monoid          )       => Monoid (GMonoid a) where-    mappend = c2 (gMappend @a)+    mappend = coerce (gMappend @a)     {-# INLINE mappend #-}-    mempty  = c0 (gMempty @a)+    mempty  = coerce (gMempty @a)     {-# INLINE mempty #-}  

@@ -45,11 +45,11 @@   , gMin   ) where +import           Data.Coerce import           Data.Data import           Data.Monoid import           GHC.Generics import           Generics.OneLiner-import           Generics.OneLiner.Instances.Internal  -- | If @a@ is a data type whose fields are all instances of 'Eq', then -- @'GOrd' a@ has a 'Eq' instance.@@ -67,9 +67,9 @@          , Constraints a Eq          )       => Eq (GOrd a) where-    (==) = c2' (gEquals @a)+    (==) = coerce (gEquals @a)     {-# INLINE (==) #-}-    (/=) = c2' (gNotEquals @a)+    (/=) = coerce (gNotEquals @a)     {-# INLINE (/=) #-}  instance ( ADT a@@ -77,19 +77,19 @@          , Constraints a Ord          )       => Ord (GOrd a) where-    compare = c2' (gCompare @a)+    compare = coerce (gCompare @a)     {-# INLINE compare #-}-    (<=)    = c2' (gLTE @a)+    (<=)    = coerce (gLTE @a)     {-# INLINE (<=) #-}-    (<)     = c2' (gLT @a)+    (<)     = coerce (gLT @a)     {-# INLINE (<) #-}-    (>=)    = c2' (gGTE @a)+    (>=)    = coerce (gGTE @a)     {-# INLINE (>=) #-}-    (>)     = c2' (gGT @a)+    (>)     = coerce (gGT @a)     {-# INLINE (>) #-}-    max     = c2 (gMax @a)+    max     = coerce (gMax @a)     {-# INLINE max #-}-    min     = c2 (gMin @a)+    min     = coerce (gMin @a)     {-# INLINE min #-}  -- | '==' implemented by using '==' between all of the

@@ -1,22 +0,0 @@--module Generics.OneLiner.Instances.Internal (-    c0-  , c1-  , c2-  , c2'-  ) where--import           Data.Coerce--c0 :: Coercible a b => b -> a-c0 = coerce--c1 :: Coercible a b => (b -> b) -> a -> a-c1 f = coerce . f . coerce--c2 :: Coercible a b => (b -> b -> b) -> a -> a -> a-c2 f x y = coerce (f (coerce x) (coerce y))--c2' :: Coercible a b => (b -> b -> c) -> a -> a -> c-c2' f x y = f (coerce x) (coerce y)-

@@ -67,10 +67,10 @@   , gAtanh   ) where +import           Data.Coerce import           Data.Data import           GHC.Generics import           Generics.OneLiner-import           Generics.OneLiner.Instances.Internal  -- | If @a@ is a data type with a single constructor whose fields are all -- instances of 'Num', then @'GNum' a@ has a 'Num' instance.@@ -89,19 +89,19 @@  instance (ADTRecord a, Constraints a Num)       => Num (GNum a) where-    (+)         = c2 (gPlus @a)+    (+)         = coerce (gPlus @a)     {-# INLINE (+) #-}-    (-)         = c2 (gMinus @a)+    (-)         = coerce (gMinus @a)     {-# INLINE (-) #-}-    (*)         = c2 (gTimes @a)+    (*)         = coerce (gTimes @a)     {-# INLINE (*) #-}-    negate      = c1 (gNegate @a)+    negate      = coerce (gNegate @a)     {-# INLINE negate #-}-    abs         = c1 (gAbs @a)+    abs         = coerce (gAbs @a)     {-# INLINE abs #-}-    signum      = c1 (gSignum @a)+    signum      = coerce (gSignum @a)     {-# INLINE signum #-}-    fromInteger = c0 (gFromInteger @a)+    fromInteger = coerce (gFromInteger @a)     {-# INLINE fromInteger #-}  instance ( ADTRecord a@@ -109,11 +109,11 @@          , Constraints a Fractional          )       => Fractional (GNum a) where-    (/)          = c2 (gDivide @a)+    (/)          = coerce (gDivide @a)     {-# INLINE (/) #-}-    recip        = c1 (gRecip @a)+    recip        = coerce (gRecip @a)     {-# INLINE recip #-}-    fromRational = c0 (gFromRational @a)+    fromRational = coerce (gFromRational @a)     {-# INLINE fromRational #-}  instance ( ADTRecord a@@ -122,41 +122,41 @@          , Constraints a Floating          )       => Floating (GNum a) where-    pi      = c0 (gPi @a)+    pi      = coerce (gPi @a)     {-# INLINE pi #-}-    exp     = c1 (gExp @a)+    exp     = coerce (gExp @a)     {-# INLINE exp #-}-    log     = c1 (gLog @a)+    log     = coerce (gLog @a)     {-# INLINE log #-}-    sqrt    = c1 (gSqrt @a)+    sqrt    = coerce (gSqrt @a)     {-# INLINE sqrt #-}-    (**)    = c2 (gPower @a)+    (**)    = coerce (gPower @a)     {-# INLINE (**) #-}-    logBase = c2 (gLogBase @a)+    logBase = coerce (gLogBase @a)     {-# INLINE logBase #-}-    sin     = c1 (gSin @a)+    sin     = coerce (gSin @a)     {-# INLINE sin #-}-    cos     = c1 (gCos @a)+    cos     = coerce (gCos @a)     {-# INLINE cos #-}-    tan     = c1 (gTan @a)+    tan     = coerce (gTan @a)     {-# INLINE tan #-}-    asin    = c1 (gAsin @a)+    asin    = coerce (gAsin @a)     {-# INLINE asin #-}-    acos    = c1 (gAcos @a)+    acos    = coerce (gAcos @a)     {-# INLINE acos #-}-    atan    = c1 (gAtan @a)+    atan    = coerce (gAtan @a)     {-# INLINE atan #-}-    sinh    = c1 (gSinh @a)+    sinh    = coerce (gSinh @a)     {-# INLINE sinh #-}-    cosh    = c1 (gCosh @a)+    cosh    = coerce (gCosh @a)     {-# INLINE cosh #-}-    tanh    = c1 (gTanh @a)+    tanh    = coerce (gTanh @a)     {-# INLINE tanh #-}-    asinh   = c1 (gAsinh @a)+    asinh   = coerce (gAsinh @a)     {-# INLINE asinh #-}-    acosh   = c1 (gAcosh @a)+    acosh   = coerce (gAcosh @a)     {-# INLINE acosh #-}-    atanh   = c1 (gAtanh @a)+    atanh   = coerce (gAtanh @a)     {-# INLINE atanh #-}  -- $num

@@ -0,0 +1,301 @@+{-# LANGUAGE BangPatterns         #-}+{-# LANGUAGE DeriveDataTypeable   #-}+{-# LANGUAGE DeriveFoldable       #-}+{-# LANGUAGE DeriveFunctor        #-}+{-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE DeriveTraversable    #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE InstanceSigs         #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TupleSections        #-}+{-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : System.Random.OneLiner+-- Description : Derived methods for Random.+-- Copyright   : (c) Justin Le 2018+-- License     : BSD-3+-- Maintainer  : justin@jle.im+-- Stability   : unstable+-- Portability : portable+--+-- Derived methods for 'Random', using "Generics.OneLiner" and+-- "GHC.Generics".+--+-- Can be used for any types (deriving 'Generic') made with a single+-- constructor, where every field is an instance of 'Random'.+--+-- Also includes a newtype wrapper that imbues any such data type with+-- instant 'Random' instances, which can one day be used with /DerivingVia/+-- syntax to derive instances automatically.+--++module System.Random.OneLiner (+  -- * Single constructor+  -- ** Newtype wrapper+    GRandom(..)+  -- ** Generics-derived methods+  , gRandomR+  , gRandom+  , gRandomRs+  , gRandoms+  , gRandomRIO+  , gRandomIO+  -- * Multiple constructor+  -- ** Newtype wrapper+  , GRandomSum(..)+  -- ** Generics-derived methods+  , gRandomRSum+  , gRandomSum+  , gRandomRSums+  , gRandomSums+  , gRandomRIOSum+  , gRandomIOSum+  ) where++import           Control.Monad+import           Data.Coerce+import           Data.Data+import           Data.Functor.Compose+import           Data.List.NonEmpty   (NonEmpty(..))+import           Data.Maybe+import           GHC.Exts             (build)+import           GHC.Generics+import           Generics.OneLiner+import           System.Random+import qualified Data.List.NonEmpty   as NE++-- | If @a@ is a data type with a single constructor whose fields are all+-- instances of 'Random', then @'GRandom' a@ has a 'Random' instance.+--+-- Will one day be able to be used with /DerivingVia/ syntax, to derive+-- instances automatically.+--+-- Only works with data types with single constructors.  If you need it to+-- work with types of multiple constructors, consider 'GRandomSum'.+newtype GRandom a = GRandom { getGRandom :: a }+  deriving (Eq, Ord, Show, Read, Data, Generic, Functor, Foldable, Traversable)++instance ( ADTRecord a+         , Constraints a Random+         )+      => Random (GRandom a) where+    randomR :: forall g. RandomGen g => (GRandom a, GRandom a) -> g -> (GRandom a, g)+    randomR = coerce (gRandomR @a @g)+    {-# INLINE randomR #-}+    random :: forall g. RandomGen g => g -> (GRandom a, g)+    random = coerce (gRandom @a @g)+    {-# INLINE random #-}+    randomRs :: forall g. RandomGen g => (GRandom a, GRandom a) -> g -> [GRandom a]+    randomRs = coerce (gRandomRs @a @g)+    {-# INLINE randomRs #-}+    randoms :: forall g. RandomGen g => g -> [GRandom a]+    randoms = coerce (gRandoms @a @g)+    {-# INLINE randoms #-}+    randomRIO :: (GRandom a, GRandom a) -> IO (GRandom a)+    randomRIO = coerce (gRandomRIO @a)+    {-# INLINE randomRIO #-}+    randomIO :: IO (GRandom a)+    randomIO = coerce (gRandomIO @a)+    {-# INLINE randomIO #-}++-- | 'randomR' implemented by sequencing 'randomR' between all components+--+-- Requires the type to have only a single constructor.+gRandomR+    :: forall a g. (ADTRecord a, Constraints a Random, RandomGen g)+    => (a, a) -> g -> (a, g)+gRandomR (l, u) = runState $+    dialgebra @Random+      (State . randomR . dePair)+      (Pair l u)+{-# INLINE gRandomR #-}++-- | 'random' implemented by sequencing 'random' for all components.+--+-- Requires the type to have only a single constructor.+gRandom+    :: forall a g. (ADTRecord a, Constraints a Random, RandomGen g)+    => g -> (a, g)+gRandom = runState $ createA' @Random (State random)+{-# INLINE gRandom #-}++-- | 'randomRs' implemented by repeatedly calling 'gRandomR'.+gRandomRs+    :: forall a g. (ADTRecord a, Constraints a Random, RandomGen g)+    => (a, a) -> g -> [a]+gRandomRs ival g = build (\cons _nil -> buildRandoms cons (gRandomR ival) g)+{-# INLINE gRandomRs #-}++-- | 'randoms' implemented by repeatedly calling 'gRandom'.+gRandoms+    :: forall a g. (ADTRecord a, Constraints a Random, RandomGen g)+    => g -> [a]+gRandoms g = build (\cons _nil -> buildRandoms cons gRandom g)+{-# INLINE gRandoms #-}++-- | 'randomRIO' implemented by calling 'gRandomR' on the global seed.+gRandomRIO+    :: forall a. (ADTRecord a, Constraints a Random)+    => (a, a) -> IO a+gRandomRIO range = getStdRandom (gRandomR range)+{-# INLINE gRandomRIO #-}++-- | 'randomIO' implemented by calling 'gRandom' on the global seed.+gRandomIO+    :: forall a. (ADTRecord a, Constraints a Random)+    => IO a+gRandomIO = getStdRandom gRandom+{-# INLINE gRandomIO #-}++-- | If @a@ is a data type whose fields are all instances of 'Random', then+-- @'GRandom' a@ has a 'Random' instance.+--+-- Will one day be able to be used with /DerivingVia/ syntax, to derive+-- instances automatically.+--+-- A version of 'GRandom' that works for data types with multiple+-- constructors.  If your type has only one constructor, it might be more+-- performant to use 'GRandom'.+--+-- Note that the "ranged" variants are partial: if given a range of items+-- made with different constructors, will be 'error'!+newtype GRandomSum a = GRandomSum { getGRandomSum :: a }+  deriving (Eq, Ord, Show, Read, Data, Generic, Functor, Foldable, Traversable)++instance ( ADT a+         , Constraints a Random+         )+      => Random (GRandomSum a) where+    randomR :: forall g. RandomGen g => (GRandomSum a, GRandomSum a) -> g -> (GRandomSum a, g)+    randomR = coerce (gRandomRSum @a @g)+    {-# INLINE randomR #-}+    random :: forall g. RandomGen g => g -> (GRandomSum a, g)+    random = coerce (gRandomSum @a @g)+    {-# INLINE random #-}+    randomRs :: forall g. RandomGen g => (GRandomSum a, GRandomSum a) -> g -> [GRandomSum a]+    randomRs = coerce (gRandomRSums @a @g)+    {-# INLINE randomRs #-}+    randoms :: forall g. RandomGen g => g -> [GRandomSum a]+    randoms = coerce (gRandomSums @a @g)+    {-# INLINE randoms #-}+    randomRIO :: (GRandomSum a, GRandomSum a) -> IO (GRandomSum a)+    randomRIO = coerce (gRandomRIOSum @a)+    {-# INLINE randomRIO #-}+    randomIO :: IO (GRandomSum a)+    randomIO = coerce (gRandomIOSum @a)+    {-# INLINE randomIO #-}++-- | 'randomR' implemented by sequencing 'randomR' between all components.+--+-- If given a range of items made with different constructors, will be+-- 'error'!+gRandomRSum+    :: forall a g. (ADT a, Constraints a Random, RandomGen g)+    => (a, a) -> g -> (a, g)+gRandomRSum (l, u) = runState . fromMaybe (error badbad) . getCompose $+    zipWithA @Random (\l' u' -> Compose (Just (State (randomR (l', u')))))+      l u+  where+    badbad = "gRandomRSum: Constructors in range do not match."+{-# INLINE gRandomRSum #-}++-- | 'random' implemented by selecting a random constructor and sequencing+-- 'random' for all components.+gRandomSum+    :: forall a g. (ADT a, Constraints a Random, RandomGen g)+    => g -> (a, g)+gRandomSum = case options of+    Nothing   -> (error "gRandomSum: Uninhabited type",)+    Just opts -> runState (join (reservoir opts))+  where+    options = NE.nonEmpty . getCompose $ createA @Random @a $+        Compose [State random]+{-# INLINE gRandomSum #-}++-- | 'randomRs' implemented by repeatedly calling 'gRandomRSum'.+--+-- If given a range of items made with different constructors, will be+-- 'error'!+gRandomRSums+    :: forall a g. (ADT a, Constraints a Random, RandomGen g)+    => (a, a) -> g -> [a]+gRandomRSums ival g = build (\cons _nil -> buildRandoms cons (gRandomRSum ival) g)+{-# INLINE gRandomRSums #-}++-- | 'randoms' implemented by repeatedly calling 'gRandomSum'.+gRandomSums+    :: forall a g. (ADT a, Constraints a Random, RandomGen g)+    => g -> [a]+gRandomSums g = build (\cons _nil -> buildRandoms cons gRandomSum g)+{-# INLINE gRandomSums #-}++-- | 'randomRIO' implemented by calling 'gRandomRSum' on the global seed.+--+-- If given a range of items made with different constructors, will be+-- 'error'!+gRandomRIOSum+    :: forall a. (ADT a, Constraints a Random)+    => (a, a) -> IO a+gRandomRIOSum range = getStdRandom (gRandomRSum range)+{-# INLINE gRandomRIOSum #-}++-- | 'randomIO' implemented by calling 'gRandom' on the global seed.+gRandomIOSum+    :: forall a. (ADT a, Constraints a Random)+    => IO a+gRandomIOSum = getStdRandom gRandomSum+{-# INLINE gRandomIOSum #-}+++data Pair a = Pair !a !a+    deriving Functor++dePair :: Pair a -> (a, a)+dePair (Pair x y) = (x, y)+{-# INLINE dePair #-}++newtype State s a = State { runState :: s -> (a, s) }+    deriving Functor++instance Applicative (State s) where+    pure x = State (x,)+    {-# INLINE pure #-}+    sf <*> sx = State $ \s0 ->+        let (f, !s1) = runState sf s0+            (x, !s2) = runState sx s1+        in  (f x, s2)+    {-# INLINE (<*>) #-}++instance Monad (State s) where+    return x = State (x,)+    {-# INLINE return #-}+    sx >>= f = State $ \s0 ->+      let (x, !s1) = runState sx s0+      in  runState (f x) s1+    {-# INLINE (>>=) #-}++buildRandoms :: RandomGen g+             => (a -> as -> as)  -- ^ E.g. '(:)' but subject to fusion+             -> (g -> (a,g))     -- ^ E.g. 'random'+             -> g                -- ^ A 'RandomGen' instance+             -> as+buildRandoms cons rand = go+  where+    -- The seq fixes part of #4218 and also makes fused Core simpler.+    go g = x `seq` (x `cons` go g') where (x,g') = rand g+{-# INLINE buildRandoms #-}++-- | Select a random item from a non-empty list in constant memory, using+-- only a single traversal, using reservoir sampling.+reservoir :: RandomGen g => NE.NonEmpty a -> State g a+reservoir (x :| xs) = go 2 x xs+  where+    go _  y []     = pure y+    go !i y (z:zs) = do+      j <- State $ randomR @Int (1, i)+      if j <= 1+        then go (i + 1) z zs+        else go (i + 1) y zs+{-# INLINE reservoir #-}