packages feed

vinyl-utils (empty) → 0.0.0.0

raw patch · 7 files changed

+308/−0 lines, 7 filesdep +basedep +contravariantdep +transformerssetup-changed

Dependencies added: base, contravariant, transformers, vinyl

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Marcin Mrotek++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Marcin Mrotek nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/Vinyl/Upcast.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE+      DataKinds+    , MultiParamTypeClasses+    , FlexibleContexts+    , FlexibleInstances+    , PolyKinds+    , ScopedTypeVariables+    , TypeFamilies+    , TypeOperators+    , UndecidableInstances+    #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Module      : Data.Vinyl.Upcast+Description : Upward cast and slicing.+Copyright   : (c) Marcin Mrotek, 2014+License     : BSD3+Maintainer  : marcin.jan.mrotek@gmail.com+-}++module Data.Vinyl.Upcast (+      Overwrite(..)+    , slice+    , (:>)(..)+    , AltRec(..)+) where++import Control.Applicative+import Data.Monoid+import Data.Vinyl+import Data.Vinyl.TyFun++-- |Overwrite a wider record with a narrower record.+class Overwrite (xs :: [k]) (ys :: [k]) where+    overwrite :: Rec el f xs -> Rec el f ys -> Rec el f xs++instance Overwrite xs '[] where+    overwrite xs _ = xs++instance (IElem y xs, Overwrite xs ys) => Overwrite xs (y ': ys) where+    overwrite xs (y :& ys) = overwrite (ith (implicitly :: Elem y xs) y xs) ys+        where +            ith :: Elem x rs ->  f (el $ x) -> Rec el f rs -> Rec el f rs+            ith Here      y (_ :& xs) = y :& xs +            ith (There p) y (x :& xs) = x :& ith p y xs++slice :: (Functor f, Overwrite xs ys, xs <: ys) +      => (Rec el g ys -> f (Rec el g ys))+      ->  Rec el g xs -> f (Rec el g xs)+-- ^A lens from a record to a portion of it.+slice k x = overwrite x <$> k (cast x)++-- |Wrapper for Rec with a different Monoid instance. Instead of lifting mappend, it acts on (f (el $ r)) directly, to support temporarily turning records into monoids by changing functors.+newtype AltRec el f rs = AltRec {getRec :: Rec el f rs}++instance Monoid (AltRec el f '[]) where+    mempty = AltRec RNil+    _ `mappend` _ = AltRec RNil++instance (Monoid (f (el $ r)), Monoid (AltRec el f rs)) => Monoid (AltRec el f (r ': rs)) where+    mempty = AltRec $ mempty :& getRec mempty+    (AltRec (x :& xs)) `mappend` (AltRec (y :& ys)) = AltRec $ (x <> y) :& getRec (AltRec xs `mappend` AltRec ys)++-- |Upward record casting.+class (Overwrite ys xs, ys <: xs) => (xs :: [k]) :> (ys :: [k]) where+    upcast :: (Monoid (AltRec el f ys)) => Rec el f xs -> Rec el f ys++instance (Overwrite ys xs, ys <: xs) => xs :> ys where+    upcast xs = overwrite (getRec mempty) xs
+ src/Data/Vinyl/Utils/Compose.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE+      DataKinds+    , PolyKinds+    #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Module      : Data.Vinyl.Utils.Compose+Description : Operations on records parametrized with composition of functors.+Copyright   : (c) Marcin Mrotek, 2014+License     : BSD3+Maintainer  : marcin.jan.mrotek@gmail.com+-}++module Data.Vinyl.Utils.Compose (+    rtraverse1+) where+import Control.Applicative+import Data.Functor.Compose+import Data.Vinyl++rtraverse1 :: Applicative f => Rec el (Compose f g) rs -> f (Rec el g rs)+-- ^Traverse a record parametrized with a composition of functors, leaving the inner functor.+rtraverse1 = rtraverse getCompose
+ src/Data/Vinyl/Utils/Const.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE+      DataKinds+    , PolyKinds+    , TypeFamilies+    , TypeOperators+    #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Module      : Data.Vinyl.Utils.Const+Description : Operations on constant type records.+Copyright   : (c) Marcin Mrotek, 2014+License     : BSD3+Maintainer  : marcin.jan.mrotek@gmail.com+-}++module Data.Vinyl.Utils.Const (+      ConstApplicative(..)+    , rconst+    , constCommute+    , rconstdist+) where++import Data.Vinyl.Utils.Compose++import Control.Applicative+import Data.Functor.Compose+import Data.Vinyl+import Data.Vinyl.TyFun++cfmap :: (a -> b) -> Rec el (Const a) rs -> Rec el (Const b) rs+-- ^Map a function over a constant type record.+cfmap _ RNil = RNil+cfmap f (Const r :& rs) = Const (f r) :& cfmap f rs++-- |Extension of 'pure' to constant type records.+class ConstApplicative (rs :: [k]) where+    cpure :: a -> Rec el (Const a) rs+ +instance ConstApplicative '[] where+    cpure = const RNil++instance ConstApplicative rs => ConstApplicative (r ': rs) where+    cpure x = Const x :& cpure x++capp  :: (Rec el (Const (a -> b)) rs) -> Rec el (Const a) rs -> Rec el (Const b) rs+-- ^Extension of (<*>) to constant type records.+capp RNil RNil = RNil+capp (Const f :& fs) (Const x :& xs) = Const (f x) :& capp fs xs++rconst :: (Applicative f, RecApplicative rs) => f a -> f (Rec el (Const a) rs)+rconst = rtraverse1 . rcpure+    where rcpure a = rpure (Compose $ Const <$> a)++constCommute :: Functor f => Const (f a) b -> Compose f (Const a) b+-- ^Commute a constant functor with another functor.+constCommute (Const a) = Compose $ Const <$> a++rconstdist :: Applicative f => Rec el (Const (f a)) rs -> f (Rec el (Const a) rs)+-- ^Distribute a functor over a constant type record.+rconstdist rec = rtraverse1 $ constCommute <<$>> rec
+ src/Data/Vinyl/Utils/Operator.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE +      ConstraintKinds+    , DataKinds+    , FlexibleContexts+    , FlexibleInstances+    , MultiParamTypeClasses+    , PolyKinds +    , RankNTypes+    , ScopedTypeVariables+    , TypeFamilies+    , TypeOperators+    #-}++{-# OPTIONS_HADDOCK show-extensions #-}++{-|+Module      : Data.Vinyl.Utils.Operator+Description : Operations on records parametrized with various kinds of functions.+Copyright   : (c) Marcin Mrotek, 2014+License     : BSD3+Maintainer  : marcin.jan.mrotek@gmail.com+-}++module Data.Vinyl.Utils.Operator (+      operator+    , (/$/), (/$$/), (\$\), (\$$\), (\&&\), (\||\)+    , p+) where++import Control.Applicative+import Data.Functor.Compose+import Data.Functor.Contravariant+import Data.Monoid+import Data.Vinyl+import Data.Vinyl.Constraint+import Data.Vinyl.TyFun++operator :: (forall t. f t -> g t -> h t) -> Rec el f rs -> Rec el g rs -> Rec el h rs+-- ^Create an operator between records sharing their universes and fields but differing in functors.+operator _ RNil RNil = RNil+operator f (a :& as) (b :& bs) = (f a b) :& operator f as bs++(/$/) :: Functor f => Rec el ((->) a) rs -> Rec el (Const (f a)) rs -> Rec el f rs+-- ^Apply a record of (a -> x) functions to a constant type record to obtain a plain f-record.+(/$/) = operator (\f (Const x) -> f <$> x)++(/$$/) :: Rec el (Compose ((->) a) f) rs -> Rec el (Const a) rs -> Rec el f rs+-- ^Apply a record of (f a -> f x) functions to a constant type record to obtain a plain f-record.+(/$$/) = operator (\(Compose f) (Const x) -> f x)++(\$\) :: Functor f => Rec el (Op a) rs -> Rec el f rs -> Rec el (Const (f a)) rs+-- ^Apply a record of (x -> a) functions to a plain f-record to obtain a constant type record.+(\$\) = operator (\(Op f) x -> Const $ f <$> x)++(\$$\) :: Rec el (Compose (Op a) f) rs -> Rec el f rs -> Rec el (Const a) rs+-- ^Apply a record of (f x -> f a) functions to a plain f-record to obtain a constant type record.+(\$$\) = operator (\(Compose (Op f)) x -> Const $ f x)++predicate (Predicate p) x = Const $ p <$> x++(\&&\) :: forall el f rs. Applicative f => Rec el Predicate rs -> Rec el f rs -> f Bool+-- ^Apply a predicate record to a plain f-record to obtain a boolean product inside the f functor.+(\&&\) p r = go result $ pure True+    where+        go :: Rec el (Const (f Bool)) xs -> f Bool -> f Bool+        go RNil b = b+        go (Const a :& as) b = go as $ (&&) <$> a <*> b+        result :: Rec el (Const (f Bool)) rs+        result = operator predicate p r+    +(\||\) :: forall el f rs. Applicative f => Rec el Predicate rs -> Rec el f rs -> f Bool+-- ^Apply a predicate record to a plain f-record to obtain a boolean sum inside the f functor.+(\||\) p r = go result $ pure False+    where +        go :: Rec el (Const (f Bool)) xs -> f Bool -> f Bool+        go RNil b = b+        go (Const a :& as) b = go as $ (||) <$> a <*> b+        result :: Rec el (Const (f Bool)) rs+        result = operator predicate p r++p :: (a -> Bool) -> Predicate a+-- ^Shorthand for creation of predicates.+p = Predicate+
+ vinyl-utils.cabal view
@@ -0,0 +1,34 @@+-- Initial vinyl-utils.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                vinyl-utils+version:             0.0.0.0+synopsis:            Utilities for vinyl+description:         Upcast operator, slicing lens, and operations on records parametrized with various kinds of functors.+license:             BSD3+license-file:        LICENSE+author:              Marcin Mrotek+maintainer:          marcin.jan.mrotek@gmail.com+-- copyright:           +category:            Control+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10+homepage:            http://hub.darcs.net/mjm/vinyl-utils+source-repository    head+    type:    darcs+    location: mjm@hub.darcs.net:mjm/vinyl-utils++library+  exposed-modules:     Data.Vinyl.Utils.Const+                      ,Data.Vinyl.Utils.Compose+                      ,Data.Vinyl.Utils.Operator+                      ,Data.Vinyl.Upcast+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.7 && <4.8+                      ,contravariant+                      ,transformers+                      ,vinyl+  hs-source-dirs:      src+  default-language:    Haskell2010