packages feed

web-inv-route 0.1.2 → 0.1.2.1

raw patch · 14 files changed

+108/−56 lines, 14 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

Web/Route/Invertible/Map/Bool.hs view
@@ -7,7 +7,7 @@   , lookupBool   ) where -import Data.Monoid ((<>))+import Data.Semigroup (Semigroup((<>)))  -- |A trivial, flat representation of a 'Bool'-keyed map. -- Value existance (but not the values themselves) is strict.@@ -19,9 +19,12 @@ instance Functor BoolMap where   fmap f (BoolMap a b) = BoolMap (fmap f a) (fmap f b) +instance (Semigroup v) => Semigroup (BoolMap v) where+  BoolMap a1 b1 <> BoolMap a2 b2 = BoolMap (a1 <> a2) (b1 <> b2)+ instance (Monoid v) => Monoid (BoolMap v) where   mempty = emptyBoolMap-  mappend (BoolMap a1 b1) (BoolMap a2 b2) = BoolMap (a1 <> a2) (b1 <> b2)+  mappend (BoolMap a1 b1) (BoolMap a2 b2) = BoolMap (mappend a1 a2) (mappend b1 b2)  -- |The empty map. emptyBoolMap :: BoolMap a
Web/Route/Invertible/Map/Const.hs view
@@ -12,7 +12,7 @@   , flattenConstDefaultMap   ) where -import Data.Monoid ((<>))+import Data.Semigroup (Semigroup((<>)))  import Web.Route.Invertible.Map.Default @@ -25,9 +25,12 @@ instance Functor m => Functor (ConstMap m) where   fmap f (ConstMap m v) = ConstMap (fmap f m) (f v) +instance (Semigroup v, Semigroup (m v)) => Semigroup (ConstMap m v) where+  ConstMap m1 v1 <> ConstMap m2 v2 = ConstMap (m1 <> m2) (v1 <> v2)+ instance (Monoid v, Monoid (m v)) => Monoid (ConstMap m v) where   mempty = ConstMap mempty mempty-  mappend (ConstMap m1 v1) (ConstMap m2 v2) = ConstMap (m1 <> m2) (v1 <> v2)+  mappend (ConstMap m1 v1) (ConstMap m2 v2) = ConstMap (mappend m1 m2) (mappend v1 v2)  -- |Transform the underlying map. withConstMap :: (m v -> n v) -> ConstMap m v -> ConstMap n v@@ -41,18 +44,18 @@ constantValue :: Monoid (m v) => v -> ConstMap m v constantValue = ConstMap mempty --- |Given a lookup function for the underlying map, add the constant value to the result (using 'mappend').-lookupConst :: Monoid v => (m v -> v) -> ConstMap m v -> v+-- |Given a lookup function for the underlying map, add the constant value to the result (using '<>').+lookupConst :: Semigroup v => (m v -> v) -> ConstMap m v -> v lookupConst l (ConstMap m v) = l m <> v  -- |Convert a 'ConstMap' to an equivalent but more efficient 'DefaultMap'. -- Although the resulting map will return the same value for lookups, combining it with other maps will have different results (this operation is not distributive).-flattenConstMap :: (Functor m, Monoid v) => ConstMap m v -> DefaultMap m v+flattenConstMap :: (Functor m, Semigroup v) => ConstMap m v -> DefaultMap m v flattenConstMap (ConstMap m v) = DefaultMap (fmap (<> v) m) (Just v)  -- |A 'DefaultMap' wrapped in a 'ConstMap', for when you want both a constant and default value. type ConstDefaultMap m = ConstMap (DefaultMap m)  -- |Do the same as 'flattenConstMap' but for 'ConstDefaultMap' by merging the resulting 'DefaultMap' layers.-flattenConstDefaultMap :: (Functor m, Monoid v) => ConstDefaultMap m v -> DefaultMap m v+flattenConstDefaultMap :: (Functor m, Semigroup v) => ConstDefaultMap m v -> DefaultMap m v flattenConstDefaultMap (ConstMap (DefaultMap m d) v) = DefaultMap (fmap (<> v) m) (d <> Just v)
Web/Route/Invertible/Map/Custom.hs view
@@ -6,10 +6,11 @@   ) where  import Data.Maybe (mapMaybe)+import Data.Semigroup (Semigroup) import Text.Show.Functions ()  newtype CustomMap q a b = CustomMap [(q -> Maybe a, b)]-  deriving (Show, Monoid)+  deriving (Show, Semigroup, Monoid)  instance Functor (CustomMap q a) where   fmap f (CustomMap l) = CustomMap $ map (fmap f) l
Web/Route/Invertible/Map/Default.hs view
@@ -10,7 +10,7 @@   ) where  import Control.Applicative ((<|>))-import Data.Monoid ((<>))+import Data.Semigroup (Semigroup((<>)))  -- |A map that also provides a default value, for when a key is not found in the underlying map, parameterized over the type of the map. data DefaultMap m v = DefaultMap@@ -21,9 +21,12 @@ instance Functor m => Functor (DefaultMap m) where   fmap f (DefaultMap m d) = DefaultMap (fmap f m) (fmap f d) +instance (Semigroup v, Semigroup (m v)) => Semigroup (DefaultMap m v) where+  DefaultMap m1 d1 <> DefaultMap m2 d2 = DefaultMap (m1 <> m2) (d1 <> d2)+ instance (Monoid v, Monoid (m v)) => Monoid (DefaultMap m v) where   mempty = DefaultMap mempty Nothing-  mappend (DefaultMap m1 d1) (DefaultMap m2 d2) = DefaultMap (m1 <> m2) (d1 <> d2)+  mappend (DefaultMap m1 d1) (DefaultMap m2 d2) = DefaultMap (mappend m1 m2) (mappend d1 d2)  -- |A simple map with no default value. defaultingMap :: m v -> DefaultMap m v
Web/Route/Invertible/Map/Monoid.hs view
@@ -12,10 +12,14 @@  import Data.Foldable (fold) import qualified Data.Map.Strict as M+import Data.Semigroup (Semigroup((<>)))  -- |A specialized version of 'M.Map'. newtype MonoidMap k a = MonoidMap { monoidMap :: M.Map k a }   deriving (Eq, Foldable, Show)++instance (Ord k, Semigroup a) => Semigroup (MonoidMap k a) where+  MonoidMap a <> MonoidMap b = MonoidMap $ M.unionWith (<>) a b  -- |'mappend' is equivalent to @'M.unionWith' 'mappend'@. instance (Ord k, Monoid a) => Monoid (MonoidMap k a) where
Web/Route/Invertible/Map/MonoidHash.hs view
@@ -13,10 +13,14 @@ import Data.Foldable (fold) import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as M+import Data.Semigroup (Semigroup((<>)))  -- |A specialized version of 'M.HashMap'. newtype MonoidHashMap k a = MonoidHashMap { monoidHashMap :: M.HashMap k a }   deriving (Eq, Foldable, Show)++instance (Eq k, Hashable k, Semigroup a) => Semigroup (MonoidHashMap k a) where+  MonoidHashMap a <> MonoidHashMap b = MonoidHashMap $ M.unionWith (<>) a b  -- |'mappend' is equivalent to @'M.unionWith' 'mappend'@. instance (Eq k, Hashable k, Monoid a) => Monoid (MonoidHashMap k a) where
Web/Route/Invertible/Map/Placeholder.hs view
@@ -18,6 +18,7 @@ import Data.Dynamic (Dynamic) import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M+import Data.Semigroup (Semigroup((<>)))  import Web.Route.Invertible.String import Web.Route.Invertible.Placeholder@@ -32,6 +33,9 @@   { placeholderMapFixed :: !(HM.HashMap s a)   , placeholderMapParameter :: !(ParameterTypeMap s a)   } deriving (Eq, Show)++instance (RouteString s, Semigroup a) => Semigroup (PlaceholderMap s a) where+  (<>) = unionPlaceholderWith (<>)  -- |Values are combined using 'mappend'. instance (RouteString s, Monoid a) => Monoid (PlaceholderMap s a) where
Web/Route/Invertible/Map/Query.hs view
@@ -8,7 +8,7 @@   ) where  import qualified Data.HashMap.Lazy as HM-import Data.Monoid ((<>))+import Data.Semigroup (Semigroup((<>)))  import Web.Route.Invertible.Placeholder import Web.Route.Invertible.Map.Placeholder@@ -26,15 +26,24 @@   fmap f (QueryFinal v) = QueryFinal (fmap f v)   fmap f (QueryMap n m d) = QueryMap n (fmap (fmap f) m) (fmap f d) +instance Semigroup a => Semigroup (QueryMap a) where+  QueryFinal a <> QueryFinal b = QueryFinal (a <> b)+  q@(QueryFinal _) <> (QueryMap n m d) = QueryMap n m (q <> d)+  (QueryMap n m d) <> q@(QueryFinal _) = QueryMap n m (d <> q)+  q1@(QueryMap n1 m1 d1) <> q2@(QueryMap n2 m2 d2) = case compare n1 n2 of+    LT -> QueryMap n1 m1 (d1 <> q2)+    EQ -> QueryMap n1 (m1 <> m2) (d1 <> d2)+    GT -> QueryMap n2 m2 (q1 <> d2)+ instance Monoid a => Monoid (QueryMap a) where   mempty = QueryFinal mempty   mappend (QueryFinal a) (QueryFinal b) = QueryFinal (mappend a b)-  mappend q@(QueryFinal _) (QueryMap n m d) = QueryMap n m (q <> d)-  mappend (QueryMap n m d) q@(QueryFinal _) = QueryMap n m (d <> q)+  mappend q@(QueryFinal _) (QueryMap n m d) = QueryMap n m (mappend q d)+  mappend (QueryMap n m d) q@(QueryFinal _) = QueryMap n m (mappend d q)   mappend q1@(QueryMap n1 m1 d1) q2@(QueryMap n2 m2 d2) = case compare n1 n2 of-    LT -> QueryMap n1 m1 (d1 <> q2)-    EQ -> QueryMap n1 (m1 <> m2) (d1 <> d2)-    GT -> QueryMap n2 m2 (q1 <> d2)+    LT -> QueryMap n1 m1 (mappend d1 q2)+    EQ -> QueryMap n1 (mappend m1 m2) (mappend d1 d2)+    GT -> QueryMap n2 m2 (mappend q1 d2)  -- |The empty query map. emptyQueryMap :: QueryMap a
Web/Route/Invertible/Map/Route.hs view
@@ -20,7 +20,7 @@ import Data.Dynamic (Dynamic, toDyn) import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as Map-import Data.Monoid ((<>))+import Data.Semigroup (Semigroup((<>)))  import Web.Route.Invertible.String import Web.Route.Invertible.Sequence@@ -59,35 +59,38 @@   | RouteMapExactly   !(Exactly (m a))   deriving (Show) +instance Semigroup (RouteMapT m a) where+  m <> RouteMapExactly Blank = m+  RouteMapExactly Blank <> m = m+  RouteMapHost     a <> RouteMapHost     b = RouteMapHost     (a <> b)+  RouteMapSecure   a <> RouteMapSecure   b = RouteMapSecure   (a <> b)+  RouteMapPath     a <> RouteMapPath     b = RouteMapPath     (a <> b)+  RouteMapMethod   a <> RouteMapMethod   b = RouteMapMethod   (a <> b)+  RouteMapQuery    a <> RouteMapQuery    b = RouteMapQuery    (a <> b)+  RouteMapAccept   a <> RouteMapAccept   b = RouteMapAccept   (a <> b)+  RouteMapCustom   a <> RouteMapCustom   b = RouteMapCustom   (a <> b)+  RouteMapPriority a <> RouteMapPriority b = RouteMapPriority (a <> b)+  RouteMapExactly  a <> RouteMapExactly  b = RouteMapExactly  (a <> b)+  a@     (RouteMapHost     _) <> b = a <> RouteMapHost (defaultingValue b)+  a <> b@(RouteMapHost     _)      =      RouteMapHost (defaultingValue a) <> b+  a@     (RouteMapSecure   _) <> b = a <> RouteMapSecure (singletonBool Nothing b)+  a <> b@(RouteMapSecure   _)      =      RouteMapSecure (singletonBool Nothing a) <> b+  a@     (RouteMapPath     _) <> b = a <> RouteMapPath   (defaultingValue b)+  a <> b@(RouteMapPath     _)      =      RouteMapPath   (defaultingValue a) <> b+  a@     (RouteMapMethod   _) <> b = a <> RouteMapMethod (defaultingValue b)+  a <> b@(RouteMapMethod   _)      =      RouteMapMethod (defaultingValue a) <> b+  a@     (RouteMapQuery    _) <> b = a <> RouteMapQuery  (defaultQueryMap b)+  a <> b@(RouteMapQuery    _)      =      RouteMapQuery  (defaultQueryMap a) <> b+  a@     (RouteMapAccept   _) <> b = a <> RouteMapAccept (defaultingValue b)+  a <> b@(RouteMapAccept   _)      =      RouteMapAccept (defaultingValue a) <> b+  a@     (RouteMapCustom   _) <> b = a <> RouteMapCustom (constantValue b)+  a <> b@(RouteMapCustom   _)      =      RouteMapCustom (constantValue a) <> b+  a@     (RouteMapPriority _) <> b = a <> RouteMapPriority (Prioritized 0 b)+  a <> b@(RouteMapPriority _)      =      RouteMapPriority (Prioritized 0 a) <> b+ instance Monoid (RouteMapT m a) where   mempty = RouteMapExactly Blank-  mappend m (RouteMapExactly Blank) = m-  mappend (RouteMapExactly Blank) m = m-  mappend (RouteMapHost     a) (RouteMapHost     b) = RouteMapHost     (mappend a b)-  mappend (RouteMapSecure   a) (RouteMapSecure   b) = RouteMapSecure   (mappend a b)-  mappend (RouteMapPath     a) (RouteMapPath     b) = RouteMapPath     (mappend a b)-  mappend (RouteMapMethod   a) (RouteMapMethod   b) = RouteMapMethod   (mappend a b)-  mappend (RouteMapQuery    a) (RouteMapQuery    b) = RouteMapQuery    (mappend a b)-  mappend (RouteMapAccept   a) (RouteMapAccept   b) = RouteMapAccept   (mappend a b)-  mappend (RouteMapCustom   a) (RouteMapCustom   b) = RouteMapCustom   (mappend a b)-  mappend (RouteMapPriority a) (RouteMapPriority b) = RouteMapPriority (mappend a b)-  mappend (RouteMapExactly  a) (RouteMapExactly  b) = RouteMapExactly  (mappend a b)-  mappend   a@(RouteMapHost     _) b = mappend a (RouteMapHost (defaultingValue b))-  mappend a b@(RouteMapHost     _)   = mappend   (RouteMapHost (defaultingValue a)) b-  mappend   a@(RouteMapSecure   _) b = mappend a (RouteMapSecure (singletonBool Nothing b))-  mappend a b@(RouteMapSecure   _)   = mappend   (RouteMapSecure (singletonBool Nothing a)) b-  mappend   a@(RouteMapPath     _) b = mappend a (RouteMapPath   (defaultingValue b))-  mappend a b@(RouteMapPath     _)   = mappend   (RouteMapPath   (defaultingValue a)) b-  mappend   a@(RouteMapMethod   _) b = mappend a (RouteMapMethod (defaultingValue b))-  mappend a b@(RouteMapMethod   _)   = mappend   (RouteMapMethod (defaultingValue a)) b-  mappend   a@(RouteMapQuery    _) b = mappend a (RouteMapQuery  (defaultQueryMap b))-  mappend a b@(RouteMapQuery    _)   = mappend   (RouteMapQuery  (defaultQueryMap a)) b-  mappend   a@(RouteMapAccept   _) b = mappend a (RouteMapAccept (defaultingValue b))-  mappend a b@(RouteMapAccept   _)   = mappend   (RouteMapAccept (defaultingValue a)) b-  mappend   a@(RouteMapCustom   _) b = mappend a (RouteMapCustom (constantValue b))-  mappend a b@(RouteMapCustom   _)   = mappend   (RouteMapCustom (constantValue a)) b-  mappend   a@(RouteMapPriority _) b = mappend a (RouteMapPriority (Prioritized 0 b)) -  mappend a b@(RouteMapPriority _)   = mappend   (RouteMapPriority (Prioritized 0 a)) b +  mappend = (<>)  exactlyMap :: m a -> RouteMapT m a exactlyMap = RouteMapExactly . Exactly
Web/Route/Invertible/Map/Sequence.hs view
@@ -33,6 +33,7 @@ import Control.Invertible.Monoidal.Free import Control.Monad (MonadPlus(..)) import Control.Monad.Trans.State (evalState)+import Data.Semigroup (Semigroup((<>)))  import Web.Route.Invertible.String import Web.Route.Invertible.Placeholder@@ -50,6 +51,9 @@ unionSequenceWith :: RouteString s => (Maybe a -> Maybe a -> Maybe a) -> SequenceMap s a -> SequenceMap s a -> SequenceMap s a unionSequenceWith f (SequenceMap m1 v1) (SequenceMap m2 v2) =   SequenceMap (unionPlaceholderWith (unionSequenceWith f) m1 m2) (f v1 v2)++instance (RouteString s, Semigroup a) => Semigroup (SequenceMap s a) where+  (<>) = unionSequenceWith (<>)  -- |Values are combined using 'mappend'. instance (RouteString s, Monoid a) => Monoid (SequenceMap s a) where
Web/Route/Invertible/Monoid/Exactly.hs view
@@ -10,6 +10,7 @@  import Control.Applicative (Alternative(..)) import Control.Monad (MonadPlus(..))+import Data.Semigroup (Semigroup((<>)))  -- |A 'Maybe'-like monoid that only allows one value, overflowing into 'Conflict' when more than one 'Exactly' are combined (with '<|>' or 'Data.Monoid.<>', which thus function identically). data Exactly a@@ -45,6 +46,9 @@   _ >> _ = Blank   fail _ = Conflict instance MonadPlus Exactly++instance Semigroup (Exactly a) where+  (<>) = (<|>)  -- |Combines using the 'Alternative' instance, similar to an @'Data.Monoid.Alt' 'Maybe'@. instance Monoid (Exactly a) where
Web/Route/Invertible/Monoid/Prioritized.hs view
@@ -4,7 +4,7 @@   ( Prioritized(..)   ) where -import Data.Monoid ((<>))+import Data.Semigroup (Semigroup((<>)))  -- |A trival monoid allowing each item to be given a priority when combining. data Prioritized a = Prioritized@@ -15,11 +15,17 @@ instance Functor Prioritized where   fmap f (Prioritized p x) = Prioritized p (f x) +instance Semigroup a => Semigroup (Prioritized a) where+  a1@(Prioritized p1 x1) <> a2@(Prioritized p2 x2) = case compare p1 p2 of+    LT -> a2+    GT -> a1+    EQ -> Prioritized p1 (x1 <> x2)+ -- |Combining two values with the same priority combines the values, otherwise it discards the value with a smaller priority. instance Monoid a => Monoid (Prioritized a) where   mempty = Prioritized minBound mempty   mappend a1@(Prioritized p1 x1) a2@(Prioritized p2 x2) = case compare p1 p2 of     LT -> a2     GT -> a1-    EQ -> Prioritized p1 (x1 <> x2)+    EQ -> Prioritized p1 (mappend x1 x2)
Web/Route/Invertible/Result.hs view
@@ -5,6 +5,7 @@   ) where  import qualified Data.ByteString.Char8 as BSC+import Data.Semigroup (Semigroup((<>))) import Data.Typeable (Typeable) import Network.HTTP.Types.Header (ResponseHeaders, hAllow) import Network.HTTP.Types.Status (Status, notFound404, methodNotAllowed405, internalServerError500)@@ -26,15 +27,18 @@   fmap f (RouteResult x) = RouteResult (f x)   fmap _ MultipleRoutes = MultipleRoutes +instance Semigroup (RouteResult a) where+  RouteNotFound <> r = r+  AllowedMethods _ <> r@(RouteResult _) = r+  AllowedMethods a <> AllowedMethods b = AllowedMethods $ unionSorted a b+  r@(RouteResult _) <> AllowedMethods _ = r+  MultipleRoutes <> _ = MultipleRoutes+  r <> RouteNotFound = r+  _ <> _ = MultipleRoutes+ instance Monoid (RouteResult a) where   mempty = RouteNotFound-  mappend RouteNotFound r = r-  mappend (AllowedMethods _) r@(RouteResult _) = r-  mappend (AllowedMethods a) (AllowedMethods b) = AllowedMethods $ unionSorted a b-  mappend r@(RouteResult _) (AllowedMethods _) = r-  mappend MultipleRoutes _ = MultipleRoutes-  mappend r RouteNotFound = r-  mappend _ _ = MultipleRoutes+  mappend = (<>)  unionSorted :: Ord a => [a] -> [a] -> [a] unionSorted al@(a:ar) bl@(b:br) = case compare a b of
web-inv-route.cabal view
@@ -1,5 +1,5 @@ name:                web-inv-route-version:             0.1.2+version:             0.1.2.1 synopsis:            Composable, reversible, efficient web routing using invertible invariants and bijections description:   Utilities to route HTTP requests, mainly focused on path components.  Routes are specified using bijections and invariant functors, allowing run-time composition (routes can be distributed across modules), reverse and forward routing derived from the same specification, and O(log n) lookups.@@ -79,7 +79,7 @@     Web.Route.Invertible.Map.Route    build-depends:       -    base >= 4.8 && <5,+    base >= 4.9 && <5,     containers >= 0.5,     transformers,     hashable,