remove copy of Ap

This commit is contained in:
Andrew Martin 2016-08-01 13:06:39 -04:00
parent 4cd2a7c589
commit b33902c4a4
4 changed files with 55 additions and 53 deletions

View File

@ -23,7 +23,6 @@ library
Colonnade.Decoding.Text
Colonnade.Decoding.ByteString.Char8
Colonnade.Internal
Colonnade.Internal.Ap
build-depends:
base >= 4.7 && < 5
, contravariant

48
colonnade/hackage-docs.sh Executable file
View File

@ -0,0 +1,48 @@
#!/bin/bash
set -e
if [ "$#" -ne 1 ]; then
echo "Usage: scripts/hackage-docs.sh HACKAGE_USER"
exit 1
fi
user=$1
cabal_file=$(find . -maxdepth 1 -name "*.cabal" -print -quit)
if [ ! -f "$cabal_file" ]; then
echo "Run this script in the top-level package directory"
exit 1
fi
pkg=$(awk -F ":[[:space:]]*" 'tolower($1)=="name" { print $2 }' < "$cabal_file")
ver=$(awk -F ":[[:space:]]*" 'tolower($1)=="version" { print $2 }' < "$cabal_file")
if [ -z "$pkg" ]; then
echo "Unable to determine package name"
exit 1
fi
if [ -z "$ver" ]; then
echo "Unable to determine package version"
exit 1
fi
echo "Detected package: $pkg-$ver"
dir=$(mktemp -d build-docs.XXXXXX)
trap 'rm -r "$dir"' EXIT
# cabal haddock --hoogle --hyperlink-source --html-location='/package/$pkg-$version/docs' --contents-location='/package/$pkg-$version'
stack haddock
cp -R .stack-work/dist/x86_64-linux/Cabal-1.22.5.0/doc/html/$pkg/ $dir/$pkg-$ver-docs
# /home/andrew/.stack/snapshots/x86_64-linux/lts-5.17/7.10.3/doc/index.html
tar cvz -C $dir --format=ustar -f $dir/$pkg-$ver-docs.tar.gz $pkg-$ver-docs
curl -X PUT \
-H 'Content-Type: application/x-tar' \
-H 'Content-Encoding: gzip' \
-u "$user" \
--data-binary "@$dir/$pkg-$ver-docs.tar.gz" \
"https://hackage.haskell.org/package/$pkg-$ver/docs"

View File

@ -1,47 +0,0 @@
{-# 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

View File

@ -87,13 +87,15 @@ instance Contravariant Headless where
-- | This just actually a specialization of the free applicative.
-- Check out @Control.Applicative.Free@ in the @free@ library to
-- learn more about this.
-- learn more about this. The meanings of the fields are documented
-- slightly more in the source code. Unfortunately, haddock does not
-- play nicely with GADTs.
data Decoding f content a where
DecodingPure :: !a -- ^ function
DecodingPure :: !a -- function
-> Decoding f content a
DecodingAp :: !(f content) -- ^ header
-> !(content -> Either String a) -- ^ decoding function
-> !(Decoding f content (a -> b)) -- ^ next decoding
DecodingAp :: !(f content) -- header
-> !(content -> Either String a) -- decoding function
-> !(Decoding f content (a -> b)) -- next decoding
-> Decoding f content b
instance Functor (Decoding f content) where