compositional-data (empty) → 0.1.0.0
raw patch · 11 files changed
+301/−0 lines, 11 filesdep +basedep +bifunctordep +csetup-changed
Dependencies added: base, bifunctor, c, category, criterion, smallcheck, tasty, tasty-smallcheck, transformers, util
Files
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- bench/Main.hs +6/−0
- compositional-data.cabal +115/−0
- src/Control/Monad/Trans/Fresh.hs +33/−0
- src/Data/Comp/Equality.hs +22/−0
- src/Data/Comp/Show.hs +6/−0
- src/Data/Comp/Term.hs +63/−0
- src/Prelude.hs +15/−0
- test/Main.hs +8/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here © 2018++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 Author name here 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.
+ README.md view
@@ -0,0 +1,1 @@+# c
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Criterion.Main++main :: IO ()+main = defaultMain []
+ compositional-data.cabal view
@@ -0,0 +1,115 @@+name: compositional-data+version: 0.1.0.0+synopsis: Compositional Data Types+description: Modular data types defined as fixpoints, and term homomorphisms, like compdata package but with cleaner API+license: BSD3+license-file: LICENSE+author: M Farkas-Dyck+maintainer: strake888@gmail.com+copyright: 2018 M Farkas-Dyck+category: Data+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Control.Monad.Trans.Fresh+ , Data.Comp.Equality+ , Data.Comp.Show+ , Data.Comp.Term+ other-modules: Prelude+ build-depends: base >= 4.7 && < 5+ , bifunctor >= 0.1 && < 0.2+ , category >= 0.2.0.1 && < 0.3+ , transformers >= 0.5 && < 0.6+ , util >= 0.1.11 && < 0.2+ default-language: Haskell2010+ default-extensions: UnicodeSyntax+ , LambdaCase+ , EmptyCase+ , InstanceSigs+ , PartialTypeSignatures+ , RankNTypes+ , PolyKinds+ , ConstraintKinds+ , FlexibleContexts+ , FlexibleInstances+ , MultiParamTypeClasses+ , MonadComprehensions+ , DerivingStrategies+ , StandaloneDeriving+ , GeneralizedNewtypeDeriving+ , DeriveFunctor, DeriveFoldable, DeriveTraversable+ , PackageImports+ ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing+ -Wincomplete-record-updates -Wincomplete-uni-patterns+ -Werror=incomplete-patterns+ -Werror=incomplete-uni-patterns+ -Werror=incomplete-record-updates+ -Werror=missing-fields+ -Werror=missing-methods+ -Wno-partial-type-signatures+ -Wno-unticked-promoted-constructors++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends: base >=4.11 && <5+ , smallcheck >=1.1.4+ , tasty >=1.0+ , tasty-smallcheck >=0.8+ , c+ default-language: Haskell2010+ default-extensions: UnicodeSyntax+ , LambdaCase+ , EmptyCase+ , InstanceSigs+ , PartialTypeSignatures+ , PolyKinds+ , ConstraintKinds+ , FlexibleContexts+ , FlexibleInstances+ , MonadComprehensions+ , StandaloneDeriving+ , DeriveFunctor, DeriveFoldable, DeriveTraversable+ ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing+ -Wincomplete-record-updates -Wincomplete-uni-patterns+ -Werror=incomplete-patterns+ -Werror=incomplete-uni-patterns+ -Werror=incomplete-record-updates+ -Werror=missing-fields+ -Werror=missing-methods++benchmark bench+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Main.hs+ build-depends: base >=4.11 && <5+ , criterion >=1.4.1+ , c+ default-language: Haskell2010+ default-extensions: UnicodeSyntax+ , LambdaCase+ , EmptyCase+ , InstanceSigs+ , PartialTypeSignatures+ , PolyKinds+ , ConstraintKinds+ , FlexibleContexts+ , FlexibleInstances+ , MonadComprehensions+ , StandaloneDeriving+ , DeriveFunctor, DeriveFoldable, DeriveTraversable+ ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing+ -Wincomplete-record-updates -Wincomplete-uni-patterns+ -Werror=incomplete-patterns+ -Werror=incomplete-uni-patterns+ -Werror=incomplete-record-updates+ -Werror=missing-fields+ -Werror=missing-methods++source-repository head+ type: git+ location: https://github.com/githubuser/c.hs
+ src/Control/Monad/Trans/Fresh.hs view
@@ -0,0 +1,33 @@+module Control.Monad.Trans.Fresh (FreshT, evalFreshT, Fresh, evalFresh, withName, Name) where++import "base" Prelude (Show (..), (+), flip, ($), Eq (..))+import qualified "base" Data.Functor as Hs++import Control.Applicative (Applicative (..), Alternative (..))+import Control.Monad (Monad (..), MonadPlus (..))+import Control.Monad.Trans.Reader+import qualified Data.List as List (genericIndex, reverse)++newtype FreshT m a = FreshT { unFreshT :: ReaderT Natural m a }+ deriving newtype (Hs.Functor, Applicative, Monad, Alternative, MonadPlus)++newtype Name i = Name Natural+ deriving (Eq)++instance Category s => Functor s (->) Name where+ map _ (Name n) = Name n++instance Show (Name i) where+ show (Name n) = List.genericIndex names n+ where names = map List.reverse $ flip (:) <$> "":names <*> ['a'..'c']++evalFreshT :: FreshT m a -> m a+evalFreshT = flip runReaderT 0 . unFreshT++type Fresh = FreshT Identity++evalFresh :: Fresh a -> a+evalFresh = runIdentity . evalFreshT++withName :: Monad m => (Name i -> FreshT m a) -> FreshT m a+withName f = FreshT (asks Name) >>= FreshT . local (+1) . unFreshT . f
+ src/Data/Comp/Equality.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Comp.Equality where++import Control.Applicative+import Control.Categorical.Functor+import Control.Category.Const2+import Control.Monad.Trans.Fresh+import Data.Bool+import Data.Eq++class PEq a where+ peq :: a i -> a j -> Fresh Bool++instance Eq a => PEq (Const a) where+ peq (Const x) (Const y) = pure (x == y)++instance PEq Name where+ peq x y = pure (map (Const2 ()) x == y)++class EqH f where+ eqH :: PEq a => f Name a i -> f Name a j -> Fresh Bool
+ src/Data/Comp/Show.hs view
@@ -0,0 +1,6 @@+module Data.Comp.Show where++import Control.Monad.Trans.Fresh++class ShowH f where+ showH :: f Name (Const (Fresh [Char])) i -> Fresh [Char]
+ src/Data/Comp/Term.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.Comp.Term where++import "base" Prelude (($), Show (..), Eq (..), Applicative (..))+import Unsafe.Coerce++import Control.Monad.Trans.Fresh+import Data.Comp.Equality+import Data.Comp.Show++data Cxt (h :: Bool) f a b i where+ In :: f a (Cxt h f a b) i -> Cxt h f a b i+ Hole :: b i -> Cxt True f a b i+ Var :: a i -> Cxt h f a b i++newtype Term f i = Term { unTerm :: ∀ a . Trm f a i }++type Trm f a = Cxt False f a (Const ())++toCxt :: Bifunctor (Dual (NT (->))) (NT (->)) (NT (->)) f => Trm f a i -> Cxt h f a b i+toCxt = unsafeCoerce++instance Functor (NT (->)) (NT (->)) (f a) => Functor (NT (->)) (NT (->)) (Cxt h f a) where+ map f = NT (\ case+ Hole x -> Hole (nt f x)+ Var v -> Var v+ In t -> In (nt (map (map f :: NT (->) _ _)) t))++instance (Bifunctor (NT (->)) (NT (->)) (NT (->)) f) =>+ Functor (NT (->)) (NT (NT (->))) (Cxt h f) where+ map f = NT (bimap f (id @(NT (->))))++instance Bifunctor (NT (->)) (NT (->)) (NT (->)) f =>+ Bifunctor (NT (->)) (NT (->)) (NT (->)) (Cxt h f) where+ bimap f g = NT (\ case+ Hole x -> Hole (nt g x)+ Var v -> Var (nt f v)+ In t -> In (nt (bimap f (bimap f g :: NT (->) _ _)) t))++instance EqH f => EqH (Cxt h f) where+ eqH (In s) (In t) = eqH s t+ eqH (Hole x) (Hole y) = peq x y+ eqH (Var u) (Var v) = peq u v+ eqH _ _ = pure False++instance (EqH f, PEq a) => PEq (Cxt h f Name a) where+ peq = eqH++instance EqH f => Eq (Term f i) where+ Term x == Term y = evalFresh (eqH x y)++instance (Bifunctor (Dual (NT (->))) (NT (->)) (NT (->)) f, ShowH f) => ShowH (Cxt h f) where+ showH = \ case+ In t -> showH (bimap (Dual (id @(NT (->)))) (NT (Const . showH)) `nt` t)+ Var v -> pure $ show v+ Hole x -> getConst x++instance (Bifunctor (Dual (NT (->))) (NT (->)) (NT (->)) f, ShowH f) => Show (Term f i) where+ show = evalFresh . showH . toCxt . unTerm
+ src/Prelude.hs view
@@ -0,0 +1,15 @@+module Prelude (module A) where++import Control.Categorical.Bifunctor as A+import Control.Categorical.Functor as A+import Control.Category as A+import Control.Category.Dual as A+import Data.Bool as A (Bool (..), bool)+import Data.Char as A (Char)+import Data.Either as A (Either (..), either)+import Data.Functor.Const as A (Const (..))+import Data.Functor.Identity as A (Identity (..))+import Data.Maybe as A (Maybe (..), maybe)+import Data.Proxy as A (Proxy (..))+import Data.Void as A (Void)+import Numeric.Natural as A (Natural)
+ test/Main.hs view
@@ -0,0 +1,8 @@+module Main where++import Test.SmallCheck+import Test.Tasty+import Test.Tasty.SmallCheck++main :: IO ()+main = defaultMain $ testGroup "" []