colonnade (empty) → 0.1

raw patch · 7 files changed

+210/−0 lines, 7 filesdep +basedep +contravariantdep +vectorsetup-changed

Dependencies added: base, contravariant, vector

Files

LICENSE +30/−0
Setup.hs +2/−0
colonnade.cabal +30/−0
src/Colonnade/Decoding.hs +24/−0
src/Colonnade/Encoding.hs +15/−0
src/Colonnade/Internal/Ap.hs +47/−0
src/Colonnade/Types.hs +62/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Andrew Martin (c) 2016++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 Andrew Martin 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

+ colonnade.cabal view

@@ -0,0 +1,30 @@+name:                colonnade+version:             0.1+synopsis:            Generic types and functions for columnar encoding and decoding+description:         Please see README.md+homepage:            https://github.com/andrewthad/colonnade#readme+license:             BSD3+license-file:        LICENSE+author:              Andrew Martin+maintainer:          andrew.thaddeus@gmail.com+copyright:           2016 Andrew Martin+category:            web+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:+    Colonnade.Types+    Colonnade.Encoding+    Colonnade.Decoding+    Colonnade.Internal.Ap+  build-depends:+      base >= 4.7 && < 5+    , contravariant+    , vector+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/andrewthad/colonnade

+ src/Colonnade/Decoding.hs view

@@ -0,0 +1,24 @@+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Colonnade.Decoding where++import Colonnade.Types+import Data.Functor.Contravariant++-- | Converts the content type of a 'Decoding'. The @'Contravariant' f@+-- constraint means that @f@ can be 'Headless' but not 'Headed'.+contramapContent :: forall c1 c2 f a. Contravariant f => (c2 -> c1) -> Decoding f c1 a -> Decoding f c2 a+contramapContent f = go+  where+  go :: forall b. Decoding f c1 b -> Decoding f c2 b+  go (DecodingPure x) = DecodingPure x+  go (DecodingAp h decode apNext) =+    DecodingAp (contramap f h) (decode . f) (go apNext)++headless :: (content -> Either String a) -> Decoding Headless content a+headless f = DecodingAp Headless f (DecodingPure id)++headed :: content -> (content -> Either String a) -> Decoding Headed content a+headed h f = DecodingAp (Headed h) f (DecodingPure id)++

+ src/Colonnade/Encoding.hs view

@@ -0,0 +1,15 @@+module Colonnade.Encoding where++import Colonnade.Types+import qualified Data.Vector as Vector++mapContent :: Functor f => (c1 -> c2) -> Encoding f c1 a -> Encoding f c2 a+mapContent f (Encoding v) = Encoding+  $ Vector.map (\(h,c) -> (fmap f h,f . c)) v++headless :: (a -> content) -> Encoding Headless content a+headless f = Encoding (Vector.singleton (Headless,f))++headed :: content -> (a -> content) -> Encoding Headed content a+headed h f = Encoding (Vector.singleton (Headed h,f))+

+ src/Colonnade/Internal/Ap.hs view

@@ -0,0 +1,47 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE GADTs #-}+{-# OPTIONS_GHC -Wall #-}++module Colonnade.Internal.Ap+  ( Ap(..)+  , runAp+  , runAp_+  , liftAp+  , hoistAp+  , retractAp+  ) where++import Control.Applicative++-- | The free 'Applicative' for a 'Functor' @f@.+data Ap f a where+  Pure :: a -> Ap f a+  Ap   :: f a -> Ap f (a -> b) -> Ap f b++runAp :: Applicative g => (forall x. f x -> g x) -> Ap f a -> g a+runAp _ (Pure x) = pure x+runAp u (Ap f x) = flip id <$> u f <*> runAp u x++runAp_ :: Monoid m => (forall a. f a -> m) -> Ap f b -> m+runAp_ f = getConst . runAp (Const . f)++instance Functor (Ap f) where+  fmap f (Pure a)   = Pure (f a)+  fmap f (Ap x y)   = Ap x ((f .) <$> y)++instance Applicative (Ap f) where+  pure = Pure+  Pure f <*> y = fmap f y+  Ap x y <*> z = Ap x (flip <$> y <*> z)++liftAp :: f a -> Ap f a+liftAp x = Ap x (Pure id)+{-# INLINE liftAp #-}++hoistAp :: (forall a. f a -> g a) -> Ap f b -> Ap g b+hoistAp _ (Pure a) = Pure a+hoistAp f (Ap x y) = Ap (f x) (hoistAp f y)++retractAp :: Applicative f => Ap f a -> f a+retractAp (Pure a) = pure a+retractAp (Ap x y) = x <**> retractAp y

+ src/Colonnade/Types.hs view

@@ -0,0 +1,62 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GADTs #-}+module Colonnade.Types+  ( Encoding(..)+  , Decoding(..)+  , Headed(..)+  , Headless(..)+  ) where++import Data.Vector (Vector)+import Data.Functor.Contravariant (Contravariant(..))+import Data.Functor.Contravariant.Divisible (Divisible(..))+import qualified Data.Vector as Vector++-- | Isomorphic to 'Identity'+newtype Headed a = Headed { getHeaded :: a }+  deriving (Eq,Ord,Functor,Show,Read)++-- | Isomorphic to 'Proxy'+data Headless a = Headless+  deriving (Eq,Ord,Functor,Show,Read)++instance Contravariant Headless where+  contramap _ Headless = Headless++-- | This just actually a specialization of the free applicative.+--   Check out @Control.Applicative.Free@ in the @free@ library to+--   learn more about this.+data Decoding f content a where+  DecodingPure :: !a+               -> Decoding f content a+  DecodingAp :: !(f content)+             -> !(content -> Either String a)+             -> !(Decoding f content (a -> b))+             -> Decoding f content b++instance Functor (Decoding f content) where+  fmap f (DecodingPure a) = DecodingPure (f a)+  fmap f (DecodingAp h c apNext) = DecodingAp h c ((f .) <$> apNext)++instance Applicative (Decoding f content) where+  pure = DecodingPure+  DecodingPure f <*> y = fmap f y+  DecodingAp h c y <*> z = DecodingAp h c (flip <$> y <*> z)++newtype Encoding f content a = Encoding+  { getEncoding :: Vector (f content,a -> content) }+  deriving (Monoid)++instance Contravariant (Encoding f content) where+  contramap f (Encoding v) = Encoding+    (Vector.map (\(h,c) -> (h, c . f)) v)++instance Divisible (Encoding f content) where+  conquer = Encoding Vector.empty+  divide f (Encoding a) (Encoding b) =+    Encoding $ (Vector.++)+      (Vector.map (\(h,c) -> (h,c . fst . f)) a)+      (Vector.map (\(h,c) -> (h,c . snd . f)) b)++