one-liner 0.3 → 0.3.1

raw patch · 4 files changed

+49/−106 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• examples/defaultsignature.hs +10/−28
• examples/paradise.hs +13/−52
• one-liner.cabal +1/−1
• src/Generics/OneLiner.hs +25/−25

@@ -1,54 +1,36 @@-{-# LANGUAGE TypeFamilies, DefaultSignatures, ConstraintKinds, TypeOperators #-}+{-# LANGUAGE DeriveGeneric, DefaultSignatures, ConstraintKinds, TypeOperators, FlexibleContexts #-} -import Generics.OneLiner.ADT-import Generics.OneLiner.Functions+import GHC.Generics+import Generics.OneLiner  import Data.Monoid-import Control.Applicative -import Text.Read (readPrec) - class Size t where-  +   size :: t -> Int-  +   default size :: (ADT t, Constraints t Size) => t -> Int   size = succ . getSum . gfoldMap (For :: For Size) (Sum . size)-  + instance Size Bool instance Size a => Size (Maybe a)   class EnumAll t where-  +   enumAll :: [t]-  +   default enumAll :: (ADT t, Constraints t EnumAll) => [t]-  enumAll = concat $ buildsA (For :: For EnumAll) (const enumAll)+  enumAll = concat $ createA (For :: For EnumAll) enumAll  instance EnumAll Bool instance EnumAll a => EnumAll (Maybe a)   infixr 5 :^:-data Tree a = Leaf { value :: a } | Tree a :^: Tree a--instance ADT (Tree a) where-  -  ctorIndex Leaf{}  = 0-  ctorIndex (_:^:_) = 1-  ctorInfo _ 0 = CtorInfo "Leaf" True Prefix-  ctorInfo _ 1 = CtorInfo ":^:"  False (Infix RightAssociative 5)-  -  type Constraints (Tree a) c = (c a, c (Tree a))-  buildsRecA For sub rec = -    [ Leaf <$> sub (SelectorInfo "value" value)-    , (:^:) <$> rec (FieldInfo (\(l :^: _) -> l)) <*> rec (FieldInfo (\(_ :^: r) -> r))-    ]+data Tree a = Leaf { value :: a } | Tree a :^: Tree a deriving (Show, Generic) -instance Show a => Show (Tree a) where showsPrec = showsPrecADT-instance Read a => Read (Tree a) where readPrec = readPrecADT instance Size a => Size (Tree a) instance EnumAll a => EnumAll (Tree a) 

@@ -1,23 +1,24 @@-{-# LANGUAGE +{-# LANGUAGE     TypeFamilies+  , DeriveGeneric   , ConstraintKinds+  , FlexibleContexts   , FlexibleInstances   , DefaultSignatures   , OverlappingInstances-  , TypeSynonymInstances   #-} -import Generics.OneLiner.ADT-import Control.Applicative+import GHC.Generics+import Generics.OneLiner  -data Company  = C [Dept]               deriving (Eq, Read, Show)               -data Dept     = D Name Manager [Unit]  deriving (Eq, Read, Show)-data Unit     = PU Employee | DU Dept  deriving (Eq, Read, Show)-data Employee = E Person Salary        deriving (Eq, Read, Show)-data Person   = P Name Address         deriving (Eq, Read, Show)-data Salary   = S Float                deriving (Eq, Read, Show)                  -type Manager  = Employee +data Company  = C [Dept]               deriving (Eq, Read, Show, Generic)+data Dept     = D Name Manager [Unit]  deriving (Eq, Read, Show, Generic)+data Unit     = PU Employee | DU Dept  deriving (Eq, Read, Show, Generic)+data Employee = E Person Salary        deriving (Eq, Read, Show, Generic)+data Person   = P Name Address         deriving (Eq, Read, Show, Generic)+data Salary   = S Float                deriving (Eq, Read, Show, Generic)+type Manager  = Employee type Name     = String type Address  = String @@ -33,46 +34,6 @@ blair   = E (P "Blair"   "London")    (S 100000)  -instance ADT Company where-  type Constraints Company c = c [Dept]-  ctorInfo _ 0 = ctor "C"-  buildsA For f = [C <$> f (FieldInfo $ \(C l) -> l)]--instance ADT Dept where-  type Constraints Dept c = (c Name, c Manager, c [Unit])-  ctorInfo _ 0 = ctor "D"-  buildsA For f = [D -    <$> f (FieldInfo $ \(D n _ _) -> n) -    <*> f (FieldInfo $ \(D _ m _) -> m) -    <*> f (FieldInfo $ \(D _ _ u) -> u)]--instance ADT Unit where-  ctorIndex PU{} = 0-  ctorIndex DU{} = 1-  ctorInfo _ 0 = ctor "PU"-  ctorInfo _ 1 = ctor "DU"-  type Constraints Unit c = (c Employee, c Dept)-  buildsA For f = -    [ PU <$> f (FieldInfo $ \(PU e) -> e)-    , DU <$> f (FieldInfo $ \(DU d) -> d)-    ]--instance ADT Employee where-  type Constraints Employee c = (c Person, c Salary)-  ctorInfo _ 0 = ctor "E"-  buildsA For f = [E <$> f (FieldInfo $ \(E p _) -> p) <*> f (FieldInfo $ \(E _ s) -> s)]--instance ADT Person where-  type Constraints Person c = (c Name, c Address)-  ctorInfo _ 0 = ctor "P"-  buildsA For f = [P <$> f (FieldInfo $ \(P n _) -> n) <*> f (FieldInfo $ \(P _ a) -> a)]--instance ADT Salary where-  type Constraints Salary c = (c Float)-  ctorInfo _ 0 = ctor "S"-  buildsA For f = [S <$> f (FieldInfo $ \(S s) -> s)]--   class IncreaseSalary t where   increaseSalary :: Float -> t -> t   default increaseSalary :: (ADT t, Constraints t IncreaseSalary) => Float -> t -> t@@ -88,6 +49,6 @@ instance IncreaseSalary a => IncreaseSalary [a] instance IncreaseSalary String where   increaseSalary _ = id-  + main :: IO () main = print $ increaseSalary 0.1 genCom

@@ -1,5 +1,5 @@ Name:                 one-liner-Version:              0.3+Version:              0.3.1 Synopsis:             Constraint-based generics Description:          Write short and concise generic instances of type classes.                       .

@@ -19,7 +19,6 @@   , ConstraintKinds   , FlexibleContexts   , FlexibleInstances-  , DefaultSignatures   , ScopedTypeVariables   #-} module Generics.OneLiner (@@ -32,7 +31,7 @@   -- * Single constructor functions   op0, op1, op2,   -- * Types-  ADT, ADTRecord, Constraints, For+  ADT, ADTRecord, Constraints, For(..) ) where  import GHC.Generics@@ -41,26 +40,24 @@ import Data.Functor.Identity import Data.Monoid --- | Collect the constraint requirements for an instance for `t` of class `c`.-type family Constraints (t :: * -> *) (c :: * -> Constraint) :: Constraint-type instance Constraints V1 c = ()-type instance Constraints U1 c = ()-type instance Constraints (f :+: g) c = (Constraints f c, Constraints g c)-type instance Constraints (f :*: g) c = (Constraints f c, Constraints g c)--- | This is the only instance where actual requirements are generated.-type instance Constraints (K1 i v) c = c v-type instance Constraints (M1 i t f) c = Constraints f c+type family Constraints' (t :: * -> *) (c :: * -> Constraint) :: Constraint+type instance Constraints' V1 c = ()+type instance Constraints' U1 c = ()+type instance Constraints' (f :+: g) c = (Constraints' f c, Constraints' g c)+type instance Constraints' (f :*: g) c = (Constraints' f c, Constraints' g c)+type instance Constraints' (K1 i v) c = c v+type instance Constraints' (M1 i t f) c = Constraints' f c  class ADT' (t :: * -> *) where   ctorIndex' :: t x -> Int   ctorIndex' _ = 0   ctorCount :: proxy (t x) -> Int   ctorCount _ = 1-  f0 :: (Constraints t c, Applicative f)+  f0 :: (Constraints' t c, Applicative f)      => for c -> (forall s. c s => f s) -> [f (t ())]-  f1 :: (Constraints t c, Applicative f)+  f1 :: (Constraints' t c, Applicative f)      => for c -> (forall s. c s => s -> f s) -> t x -> f (t x)-  f2 :: (Constraints t c, Applicative f)+  f2 :: (Constraints' t c, Applicative f)      => for c -> (forall s. c s => s -> s -> f s) -> t x -> t x -> Maybe (f (t x))  instance ADT' V1 where@@ -111,6 +108,9 @@ instance ADTRecord' f => ADTRecord' (V1 :+: f) instance ADTRecord' f => ADTRecord' (f :+: V1) +-- | `Constraints` is a constraint type synonym, containing the constraint requirements for an instance for `t` of class `c`.+-- It requires an instance of class `c` for each component of `t`.+type Constraints t c = Constraints' (Rep t) c  -- | `ADT` is a constraint type synonym. The `Generic` instance can be derived, -- and any generic representation will be an instance of `ADT'`.@@ -132,7 +132,7 @@ -- `minBound` = `head` `$` `create` (`For` :: `For` `Bounded`) `minBound` -- `maxBound` = `last` `$` `create` (`For` :: `For` `Bounded`) `maxBound` -- @-create :: (ADT t, Constraints (Rep t) c)+create :: (ADT t, Constraints t c)        => for c -> (forall s. c s => s) -> [t] create for f = map runIdentity (createA for (Identity f)) @@ -143,7 +143,7 @@ -- @ -- get = getWord8 `>>=` \\ix -> `createA` (`For` :: `For` Binary) get `!!` `fromEnum` ix -- @-createA :: (ADT t, Constraints (Rep t) c, Applicative f)+createA :: (ADT t, Constraints t c, Applicative f)         => for c -> (forall s. c s => f s) -> [f t] createA for f = map (fmap to) (f0 for f) @@ -161,7 +161,7 @@ ctorIndex = ctorIndex' . from  -- | Map over a structure, updating each component.-gmap :: (ADT t, Constraints (Rep t) c)+gmap :: (ADT t, Constraints t c)      => for c -> (forall s. c s => s -> s) -> t -> t gmap for f = runIdentity . gtraverse for (Identity . f) @@ -172,18 +172,18 @@ -- @ -- size = `succ` `.` `getSum` `.` `gfoldMap` (`For` :: `For` Size) (`Sum` `.` size) -- @-gfoldMap :: (ADT t, Constraints (Rep t) c, Monoid m)+gfoldMap :: (ADT t, Constraints t c, Monoid m)          => for c -> (forall s. c s => s -> m) -> t -> m gfoldMap for f = getConst . gtraverse for (Const . f)  -- | Map each component of a structure to an action, evaluate these actions from left to right, and collect the results.-gtraverse :: (ADT t, Constraints (Rep t) c, Applicative f)+gtraverse :: (ADT t, Constraints t c, Applicative f)           => for c -> (forall s. c s => s -> f s) -> t -> f t gtraverse for f = fmap to . f1 for f . from  -- | Combine two values by combining each component of the structures with the given function. -- Returns `Nothing` if the constructors don't match.-gzipWith :: (ADT t, Constraints (Rep t) c)+gzipWith :: (ADT t, Constraints t c)          => for c -> (forall s. c s => s -> s -> s) -> t -> t -> Maybe t gzipWith for f l r = runIdentity <$> zipWithA for (\x y -> Identity (f x y)) l r @@ -193,13 +193,13 @@ -- @ -- `compare` s t = `compare` (`ctorIndex` s) (`ctorIndex` t) `<>` `mzipWith` (`For` :: `For` `Ord`) `compare` s t -- @-mzipWith :: (ADT t, Constraints (Rep t) c, Monoid m)+mzipWith :: (ADT t, Constraints t c, Monoid m)          => for c -> (forall s. c s => s -> s -> m) -> t -> t -> m mzipWith for f l r = maybe mempty getConst $ zipWithA for (\x y -> Const (f x y)) l r  -- | Combine two values by combining each component of the structures with the given function, under an applicative effect. -- Returns `Nothing` if the constructors don't match.-zipWithA :: (ADT t, Constraints (Rep t) c, Applicative f)+zipWithA :: (ADT t, Constraints t c, Applicative f)          => for c -> (forall s. c s => s -> s -> f s) -> t -> t -> Maybe (f t) zipWithA for f l r = fmap (fmap to) (f2 for f (from l) (from r)) @@ -209,7 +209,7 @@ -- `mempty` = `op0` (`For` :: `For` `Monoid`) `mempty` -- `fromInteger` i = `op0` (`For` :: `For` `Num`) (`fromInteger` i) -- @-op0 :: (ADTRecord t, Constraints (Rep t) c)+op0 :: (ADTRecord t, Constraints t c)     => for c -> (forall s. c s => s) -> t op0 for f = head $ create for f @@ -219,7 +219,7 @@ -- @ -- `negate` = `op1` (`For` :: `For` `Num`) `negate` -- @-op1 :: (ADTRecord t, Constraints (Rep t) c)+op1 :: (ADTRecord t, Constraints t c)      => for c -> (forall s. c s => s -> s) -> t -> t op1 = gmap @@ -229,7 +229,7 @@ -- `mappend` = `op2` (`For` :: `For` `Monoid`) `mappend` -- (`+`) = `op2` (`For` :: `For` `Num`) (`+`) -- @-op2 :: (ADTRecord t, Constraints (Rep t) c)+op2 :: (ADTRecord t, Constraints t c)     => for c -> (forall s. c s => s -> s -> s) -> t -> t -> t op2 for f l r = case gzipWith for f l r of   Just t -> t