From dc71d3043823ddb20c01f4e1eb7dac9d1dfc22e9 Mon Sep 17 00:00:00 2001 From: Andrew Martin Date: Tue, 21 Jun 2016 19:38:54 -0400 Subject: [PATCH] initial commit --- .gitignore | 37 +++++++++ colonnade/LICENSE | 30 ++++++++ colonnade/Setup.hs | 2 + colonnade/app/Main.hs | 6 ++ colonnade/colonnade.cabal | 30 ++++++++ colonnade/src/Colonnade/Decoding.hs | 24 ++++++ colonnade/src/Colonnade/Encoding.hs | 15 ++++ colonnade/src/Colonnade/Internal/Ap.hs | 47 ++++++++++++ colonnade/src/Colonnade/Types.hs | 62 +++++++++++++++ reflex-dom-colonnade/LICENSE | 30 ++++++++ reflex-dom-colonnade/Setup.hs | 2 + reflex-dom-colonnade/app/Main.hs | 6 ++ .../reflex-dom-colonnade.cabal | 29 +++++++ .../src/Reflex/Dom/Colonnade.hs | 15 ++++ stack.yaml | 75 +++++++++++++++++++ 15 files changed, 410 insertions(+) create mode 100644 .gitignore create mode 100644 colonnade/LICENSE create mode 100644 colonnade/Setup.hs create mode 100644 colonnade/app/Main.hs create mode 100644 colonnade/colonnade.cabal create mode 100644 colonnade/src/Colonnade/Decoding.hs create mode 100644 colonnade/src/Colonnade/Encoding.hs create mode 100644 colonnade/src/Colonnade/Internal/Ap.hs create mode 100644 colonnade/src/Colonnade/Types.hs create mode 100644 reflex-dom-colonnade/LICENSE create mode 100644 reflex-dom-colonnade/Setup.hs create mode 100644 reflex-dom-colonnade/app/Main.hs create mode 100644 reflex-dom-colonnade/reflex-dom-colonnade.cabal create mode 100644 reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs create mode 100644 stack.yaml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..6b8ee81 --- /dev/null +++ b/.gitignore @@ -0,0 +1,37 @@ +*.aux +cabal-dev +.cabal-sandbox +cabal.config +cabal.sandbox.config +*.chi +*.chs.h +config/client_session_key.aes +playground/ +dist* +.DS_Store +*.dyn_hi +*.dyn_o +*.hi +*.hp +.hpc +.ghci +.hsenv* +*.o +*.prof +*.sqlite3 +untracked/ +uploads/ +static/combined/ +static/tmp/ +*.swp +.virtualenv +.stack-work/ +yesod-devel/ +tmp/ +config/client_session_key.aes +playground/auth.txt +**/*.dump-hi +tags +TAGS + +docs/db/unthreat diff --git a/colonnade/LICENSE b/colonnade/LICENSE new file mode 100644 index 0000000..9beb3f9 --- /dev/null +++ b/colonnade/LICENSE @@ -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. \ No newline at end of file diff --git a/colonnade/Setup.hs b/colonnade/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/colonnade/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/colonnade/app/Main.hs b/colonnade/app/Main.hs new file mode 100644 index 0000000..de1c1ab --- /dev/null +++ b/colonnade/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Lib + +main :: IO () +main = someFunc diff --git a/colonnade/colonnade.cabal b/colonnade/colonnade.cabal new file mode 100644 index 0000000..be99a16 --- /dev/null +++ b/colonnade/colonnade.cabal @@ -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 diff --git a/colonnade/src/Colonnade/Decoding.hs b/colonnade/src/Colonnade/Decoding.hs new file mode 100644 index 0000000..f770540 --- /dev/null +++ b/colonnade/src/Colonnade/Decoding.hs @@ -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) + + diff --git a/colonnade/src/Colonnade/Encoding.hs b/colonnade/src/Colonnade/Encoding.hs new file mode 100644 index 0000000..06738a5 --- /dev/null +++ b/colonnade/src/Colonnade/Encoding.hs @@ -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)) + diff --git a/colonnade/src/Colonnade/Internal/Ap.hs b/colonnade/src/Colonnade/Internal/Ap.hs new file mode 100644 index 0000000..7831ca4 --- /dev/null +++ b/colonnade/src/Colonnade/Internal/Ap.hs @@ -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 diff --git a/colonnade/src/Colonnade/Types.hs b/colonnade/src/Colonnade/Types.hs new file mode 100644 index 0000000..94d96b2 --- /dev/null +++ b/colonnade/src/Colonnade/Types.hs @@ -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) + + diff --git a/reflex-dom-colonnade/LICENSE b/reflex-dom-colonnade/LICENSE new file mode 100644 index 0000000..9beb3f9 --- /dev/null +++ b/reflex-dom-colonnade/LICENSE @@ -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. \ No newline at end of file diff --git a/reflex-dom-colonnade/Setup.hs b/reflex-dom-colonnade/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/reflex-dom-colonnade/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/reflex-dom-colonnade/app/Main.hs b/reflex-dom-colonnade/app/Main.hs new file mode 100644 index 0000000..de1c1ab --- /dev/null +++ b/reflex-dom-colonnade/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import Lib + +main :: IO () +main = someFunc diff --git a/reflex-dom-colonnade/reflex-dom-colonnade.cabal b/reflex-dom-colonnade/reflex-dom-colonnade.cabal new file mode 100644 index 0000000..971df63 --- /dev/null +++ b/reflex-dom-colonnade/reflex-dom-colonnade.cabal @@ -0,0 +1,29 @@ +name: reflex-dom-colonnade +version: 0.1 +synopsis: Use colonnade with reflex-dom +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: + Reflex.Dom.Colonnade + build-depends: + base >= 4.7 && < 5 + , colonnade + , contravariant + , vector + , reflex-dom + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/andrewthad/colonnade diff --git a/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs new file mode 100644 index 0000000..ef79ece --- /dev/null +++ b/reflex-dom-colonnade/src/Reflex/Dom/Colonnade.hs @@ -0,0 +1,15 @@ +module Reflex.Dom.Colonnade where + +import Colonnade.Types +import Reflex.Dom.Widget.Basic + +-- hmm... +-- data WithAttrs + +basic :: MonadWidget t m + => Encoding Headed (m ()) Int + -> m () +basic (Encoding v) = do + el "table" $ do + el "thead" $ mapM_ (getHeaded . fst) v + diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..761a1bd --- /dev/null +++ b/stack.yaml @@ -0,0 +1,75 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-6.4 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- 'colonnade' +- 'reflex-dom-colonnade' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: +- 'reflex-dom-0.3' +- 'ref-tf-0.4' +- 'reflex-0.4.0' +- 'aeson-0.9.0.1' +- 'haskell-src-exts-1.16.0.1' +- 'syb-0.5.1' + + + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.1" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor