variation (empty) → 0.1.0.0

raw patch · 6 files changed

+305/−0 lines, 6 filesdep +basedep +cerealdep +containerssetup-changed

Dependencies added: base, cereal, containers, deepseq, semigroupoids, semigroups, transformers

Files

LICENSE +30/−0
Setup.hs +2/−0
src/Data/Monoid1.hs +82/−0
src/Data/Variation.hs +134/−0
src/Data/Variation/Instances.hs +17/−0
variation.cabal +40/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2017, Chris Pollard++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 Chris Pollard 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/Monoid1.hs view

@@ -0,0 +1,82 @@+module Data.Monoid1+  ( Unit1(..), Append1(..), Monoid1+  ) where++import           Control.Applicative (Const (..), WrappedMonad (..))+import qualified Data.IntMap.Strict  as IM+import qualified Data.Map            as M+import           Data.Monoid+++-- | the class of containers with a "nil" element+class Unit1 m where+  empty1 :: m a++instance Unit1 [] where+  empty1 = mempty++instance Unit1 IM.IntMap where+  empty1 = mempty++instance Unit1 (M.Map k) where+  empty1 = M.empty++instance Monoid a => Unit1 (Const a) where+  empty1 = mempty++instance Unit1 First where+  empty1 = mempty++instance Unit1 Last where+  empty1 = mempty+++-- | the class of containers that can be combined regardless of type they+-- contain+class Append1 m where++  append1 :: m a -> m a -> m a++instance Append1 [] where+  append1 = mappend++instance Append1 IM.IntMap where+  append1 = mappend++instance Ord k => Append1 (M.Map k) where+  append1 = mappend++instance Monoid a => Append1 (Const a) where+  append1 = mappend++instance Append1 First where+  append1 = mappend++instance Append1 Last where+  append1 = mappend+++-- | the class of containers that form a 'Monoid' regardless of the type they+-- contain+class (Unit1 m, Append1 m) => Monoid1 m where++instance Monoid1 [] where++instance Monoid1 IM.IntMap where++instance Ord k => Monoid1 (M.Map k) where++instance Monoid a => Monoid1 (Const a) where++instance Monoid1 First where++instance Monoid1 Last where+++instance Unit1 m => Unit1 (WrappedMonad m) where+  empty1 = WrapMonad empty1++instance Append1 m => Append1 (WrappedMonad m) where+  WrapMonad x `append1` WrapMonad y = WrapMonad $ x `append1` y++instance Monoid1 m => Monoid1 (WrappedMonad m) where

+ src/Data/Variation.hs view

@@ -0,0 +1,134 @@+{-# LANGUAGE DeriveFoldable    #-}+{-# LANGUAGE DeriveFunctor     #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts  #-}+++module Data.Variation+  (+  -- * Variation+    Variation(..)++  -- * Lenses+    , nominal, variations+  ) where++import           Control.DeepSeq+import           Data.Functor.Apply+import           Data.Functor.Bind+import           Data.Functor.Classes+import           Data.Monoid1+import           Data.Semigroup+import           Data.Serialize           (Serialize)+import           Data.Variation.Instances as X ()+import           GHC.Generics+++-- | the variation type contains+--+--   [@_nominal@] : a nominal value that will always exist+--+--   [@_variations@] : alternative values which are held inside a container of+--                     type @f@+--+-- it is strict in both arguments.+--+-- the 'Applicative' instance uses the 'Unit1' instance of @f@ to define pure+--+-- > pure x = Variation x empty1+--+-- and the 'Bind' and 'Append1' instances of @f@ to define '<*>'+--+-- > Variation f fs <*> Variation x xs =+-- >   Variation+-- >     (f x)+-- >     ((fs <.> xs) `append1` (f <$> xs) `append1` (($ x) <$> fs))+--+-- the 'Monad' instance uses the 'Bind' instance of @f@ ('join') to collapse+-- collections of type @f (f a)@+--+-- > joinV :: (Bind f, Monoid1 f) => Variation f (Variation f a) -> Variation f a+-- > joinV (Variation (Variation nn nv) v) =+-- >   let vv = _variations <$> v+-- >       vn = _nominal <$> v+-- >   in Variation nn $ join vv `append1` vn `append1` nv+--+-- other useful instances:+--+-- > instance Append1 f => Semigroup (Variation f a) where+-- >   (<>) = append1+--+-- > instance (Monoid a, Monoid1 f) => Monoid (Variation f a) where+-- >   mempty = Variation mempty empty1+-- >   mappend = (<>)++++data Variation f a =+  Variation+    { _nominal    :: !a+    , _variations :: !(f a)+    } deriving (Generic, Functor, Foldable, Traversable)+++nominal :: Functor f => (a -> f a) -> Variation t a -> f (Variation t a)+nominal f (Variation n v) = flip Variation v <$> f n++variations :: Functor f => (t a -> f (t a)) -> Variation t a -> f (Variation t a)+variations f (Variation n v) = Variation n <$> f v+++instance (NFData a, NFData (f a)) => NFData (Variation f a)++instance (Serialize a, Serialize (f a)) => Serialize (Variation f a) where+++-- some thoughts:+-- the requirements of Apply f and Monoid1 f appear to be related to+-- the Align typeclass in the "these" package.+-- there's something going on there.++-- what if we want to use ZipList here? it seems there is no monad instance+-- for ZipList, which makes it difficult to use (Variation ZipList a)...++instance (Apply f, Monoid1 f) => Applicative (Variation f) where+  pure = flip Variation empty1+  Variation f fs <*> Variation x xs =+    Variation+      (f x)+      ((fs <.> xs) `append1` (f <$> xs) `append1` (($ x) <$> fs))+++joinV :: (Bind f, Monoid1 f) => Variation f (Variation f a) -> Variation f a+joinV (Variation (Variation nn nv) v) =+  let vv = _variations <$> v+      vn = _nominal <$> v+  in Variation nn $ join vv `append1` vn `append1` nv+++instance (Bind f, Monoid1 f) => Monad (Variation f) where+  return = pure+  p >>= f = joinV $ f <$> p+++instance Append1 f => Append1 (Variation f) where+  Variation x xs `append1` Variation _ ys = Variation x (xs `append1` ys)+++instance Append1 f => Semigroup (Variation f a) where+  (<>) = append1+++instance (Monoid a, Monoid1 f) => Monoid (Variation f a) where+  mempty = Variation mempty empty1+  mappend = (<>)+++instance Show1 f => Show1 (Variation f) where+  liftShowsPrec f g n (Variation x xs) =+    showsBinaryWith f (liftShowsPrec f g) "Variation" n x xs+++instance (Show1 f, Show a) => Show (Variation f a) where+  showsPrec = showsPrec1

+ src/Data/Variation/Instances.hs view

@@ -0,0 +1,17 @@+{-# OPTIONS_GHC -fno-warn-orphans  #-}++module Data.Variation.Instances where+++import           Data.Functor.Classes+import qualified Data.Map.Strict      as M++instance Show2 M.Map where+  liftShowsPrec2 spk slk spv slv d m =+    showsUnaryWith (liftShowsPrec sp sl) "fromList" d (M.toList m)+    where+      sp = liftShowsPrec2 spk slk spv slv+      sl = liftShowList2 spk slk spv slv++instance Show k => Show1 (M.Map k) where+  liftShowsPrec = liftShowsPrec2 showsPrec showList

+ variation.cabal view

@@ -0,0 +1,40 @@+name:                variation+version:             0.1.0.0+synopsis: nominal value with possible variations+description:+  this package provides a Variation data type: a (mandatory) nominal value with+  possible associated variations on that nominal value.+license:             BSD3+license-file:        LICENSE+author:              Chris Pollard+maintainer:          cspollard@gmail.com+-- copyright:+category:            Data+build-type:          Simple+cabal-version:       >=1.10++Tested-With:  GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3+            , GHC == 8.0.1, GHC == 8.0.2++source-repository head+  type:     git+  location: http://github.com/cspollard/variation+++library+  exposed-modules:     Data.Variation+                     , Data.Monoid1+                     , Data.Variation.Instances+  -- other-modules:+  -- other-extensions:+  build-depends:       base >= 4.8 && < 5.0+                     , cereal >= 0.5 && < 0.6+                     , deepseq >= 1.4 && < 1.5+                     , containers >= 0.5 && < 0.6+                     , semigroupoids >= 5.0 && < 6.0+                     , transformers >= 0.5 && < 0.6+                     , semigroups >= 0.18 && < 0.19+  hs-source-dirs:      src+  default-language:    Haskell2010+  ghc-options:         -Wall+  -- ghc-prof-options:    -Wall -caf-all