packages feed

compdata-fixplate (empty) → 0.1

raw patch · 4 files changed

+313/−0 lines, 4 filesdep +basedep +compositiondep +containerssetup-changed

Dependencies added: base, composition, containers, deriving-compat, fixplate, tree-view

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Emil Axelsson++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 Emil Axelsson 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
+ compdata-fixplate.cabal view
@@ -0,0 +1,36 @@+name:                compdata-fixplate+version:             0.1+synopsis:            Compdata basics implemented on top of Fixplate+description:         This package implements the basic interface of+                     <https://hackage.haskell.org/package/compdata Compdata>+                     using other packages which together provide similar+                     functionality.+                     .+                     Notably:+                     .+                     * <https://hackage.haskell.org/package/fixplate Fixplate>+                       provides the basic term representation and generic+                       traversals,+                     .+                     * <https://hackage.haskell.org/package/deriving-compat deriving-compat>+                       provides generic deriving of type classes for functor+                       types.+license:             BSD3+license-file:        LICENSE+author:              Emil Axelsson+maintainer:          78emil@gmail.com+copyright:           2018 Emil Axelsson+category:            Generics+build-type:          Simple+cabal-version:       >=1.10++library+  exposed-modules:   Data.Comp.Fixplate+  build-depends:     base < 5,+                     composition,+                     containers,+                     deriving-compat,+                     fixplate < 0.2,+                     tree-view+  hs-source-dirs:    src+  default-language:  Haskell2010
+ src/Data/Comp/Fixplate.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeOperators #-}++-- | A replacement for the basic machinery in+-- [Compdata](https://hackage.haskell.org/package/compdata).+--+-- = Differences and limitations+--+-- === Deriving of type classes for base functors+--+-- Compdata's macros for deriving are replaced by similar macros from+-- [deriving-compat](https://hackage.haskell.org/package/deriving-compat). See+-- the documentation for 'defaultEqualF' and similar functions in the same+-- section.+--+-- === Co-products and injections+--+-- Compdata and Fixplate use different names for equivalent things. For this+-- reason, we export type and pattern synonyms to make the interface as similar+-- to Compdata's as possible.+--+-- Unfortunately, ':+:' is defined as left-associative in Fixplate, which means+-- that injections will look differently. For example, consider a compound base+-- functor @F `:+:` G `:+:` H@. Elements from @G@ are injected differently in+-- the two libraries:+--+-- @+-- Inr (Inl ...) -- Compdata+-- `InL` (`InR` ...) -- Fixplate+-- @+--+-- (Note also the difference in capitalization.)+--+-- === Smart constructors+--+-- There are no TemplateHaskell macros for making smart constructors, but the+-- operators from "Data.Composition" (re-exported by this module) take us a long+-- way towards the same goal. Consider the following base functors:+--+-- > data Add a        = Add a a          deriving (Functor)+-- > data IfThenElse a = IfThenElse a a a deriving (Functor)+--+-- Smart versions of these constructors can now be defined as follows:+--+-- @+-- (|+|) :: Add `:<:` f => `Term` f -> `Term` f -> `Term` f+-- (|+|) = `inject` `.:` Add+--+-- ite :: IfThenElse `:<:` f => `Term` f -> `Term` f -> `Term` f -> `Term` f+-- ite = `inject` `.:.` IfThenElse+-- @++module Data.Comp.Fixplate+  ( -- * Basic classes and operations on functors+    Eq1, EqF (..)+  , Show1, ShowF (..)+  , deriveEq1+  , deriveShow1+  , defaultEqualF+  , defaultShowsPrecF+  , eqMod++    -- * Compositional data types+  , Term+  , pattern Term+  , unTerm+  , (:&:)+  , pattern (:&:)+  , (:+:) (..)+  , (:<:) (..)+  , inject+  , project++    -- * Rendering+  , HideInj -- Just the type, because it shows up in some class contexts+  , showTerm+  , showTermU+  , drawTerm+  , drawTermU++    -- * Making smart constructors+  , (.:)+  , (.:.)+  , (.::)+  , (.::.)+  , (.:::)+  ) where++import Data.Composition ((.:), (.:.), (.::), (.::.), (.:::))+import Data.Eq.Deriving (deriveEq1)+import Data.Foldable (toList)+import Data.Functor.Classes (Eq1 (..), Show1 (..), eq1, showsPrec1)+import Data.Generics.Fixplate.Base+  ( Ann(..)+  , EqF(..)+  , Hole(..)+  , Mu(..)+  , ShowF(..)+  , showF+  )+import qualified Data.Generics.Fixplate.Draw as Fixplate+import Data.Generics.Fixplate.Functor ((:+:) (..))+import Data.Generics.Fixplate.Morphisms (cata)+import Data.Generics.Fixplate.Traversals (restructure)+import Data.Tree (Tree (..))+import qualified Data.Tree.View as TreeView+import Text.Show.Deriving (deriveShow1)++++--------------------------------------------------------------------------------+-- * Basic classes and operations on functors+--------------------------------------------------------------------------------++-- | Default implementation of 'equalF'+--+-- Use as follows:+--+-- @+-- data F = ...+--+-- `deriveEq1` ''F -- Requires TemplateHaskell+-- instance `EqF` F where `equalF` = `defaultEqualF`+-- @+defaultEqualF :: (Eq1 f, Eq a) => f a -> f a -> Bool+defaultEqualF = eq1++-- | Default implementation of 'showsPrecF'+--+-- Use as follows:+--+-- @+-- data F = ...+--+-- `deriveShow1` ''F -- Requires TemplateHaskell+-- instance `ShowF` F where `showsPrecF` = `defaultShowsPrecF`+-- @+defaultShowsPrecF :: (Show1 f, Show a) => Int -> f a -> ShowS+defaultShowsPrecF = showsPrec1++eqMod :: (EqF f, Functor f, Foldable f) => f a -> f b -> Maybe [(a, b)]+eqMod t u+  | fmap (const ()) t `equalF` fmap (const ()) u = Just args+  | otherwise = Nothing+  where+    args = toList t `zip` toList u++++--------------------------------------------------------------------------------+-- * Compositional data types+--------------------------------------------------------------------------------++type Term = Mu++pattern Term :: f (Term f) -> Term f+pattern Term f = Fix f++unTerm :: Term f -> f (Term f)+unTerm (Term f) = f++type f :&: a = Ann f a++pattern (:&:) :: f b -> a -> (f :&: a) b+pattern f :&: a = Ann a f++class f :<: g where+  inj :: f a -> g a+  prj :: g a -> Maybe (f a)++infix 7 :<:++instance {-# OVERLAPPABLE #-} f :<: f where+  inj = id+  prj = Just++instance {-# OVERLAPPING #-} f :<: f => f :<: (g :+: f) where+  inj = InR+  prj (InL _) = Nothing+  prj (InR f) = Just f++-- | Unlike standard Data Types à la Carte, this instance recurses into the left+-- term. This is due to the left-associativity of ':+:' in Fixplate.+instance {-# OVERLAPS #-} f :<: h => f :<: (h :+: g) where+  inj = InL . inj+  prj (InL h) = prj h+  prj (InR _) = Nothing++inject :: f :<: g => f (Term g) -> Term g+inject = Fix . inj++project :: f :<: g => Term g -> Maybe (f (Term g))+project = prj . unTerm++++--------------------------------------------------------------------------------+-- * Tree rendering+--------------------------------------------------------------------------------++-- | Convert a 'Term' to a 'Tree'+toTree :: (Functor f, Foldable f) => Term f -> Tree (f Hole)+toTree = cata $ \f -> Node (const Hole <$> f) $ toList f++-- Wrapper type with a 'ShowF' instance that does not show injections ('InL',+-- 'InR')+newtype HideInj f a = HideInj {unHideInj :: f a}+  deriving (Foldable, Functor, Traversable)++instance {-# OVERLAPPABLE #-}  ShowF f => ShowF (HideInj f) where+  showsPrecF p = showsPrecF p . unHideInj++instance {-# OVERLAPPING #-} (ShowF (HideInj f), ShowF (HideInj g)) =>+                             ShowF (HideInj (f :+: g)) where+  showsPrecF p (HideInj (InL f)) = showsPrecF p (HideInj f)+  showsPrecF p (HideInj (InR g)) = showsPrecF p (HideInj g)++data Hole' = Hole'++instance Show Hole' where+  show Hole' = "_"++-- | Represent a 'Term' as an ASCII drawing+showTerm :: (Functor f, Foldable f, ShowF (HideInj f)) => Term f -> String+showTerm = Fixplate.showTree . restructure HideInj++-- | Represent a 'Term' as a Unicode drawing+showTermU :: (Functor f, Foldable f, ShowF (HideInj f)) => Term f -> String+showTermU =+  TreeView.showTree . fmap (showF . HideInj . fmap (const Hole')) . toTree++-- | Display a 'Term' as an ASCII drawing+drawTerm :: (Functor f, Foldable f, ShowF (HideInj f)) => Term f -> IO ()+drawTerm = Fixplate.drawTree . restructure HideInj++-- | Display a 'Term' as a Unicode drawing+drawTermU :: (Functor f, Foldable f, ShowF (HideInj f)) => Term f -> IO ()+drawTermU = putStrLn . showTermU