annotated-fix (empty) → 0.1.0.0

raw patch · 5 files changed

+170/−0 lines, 5 filesdep +basedep +recursion-schemessetup-changed

Dependencies added: base, recursion-schemes

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
Setup.hs +2/−0
annotated-fix.cabal +31/−0
src/Data/Functor/Annotated.hs +102/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for decorated++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, Guerric Chupin++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 Guerric Chupin 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

+ annotated-fix.cabal view

@@ -0,0 +1,31 @@+cabal-version:       >=1.10+-- Initial package description 'decorated.cabal' generated by 'cabal init'.+--   For further documentation, see http://haskell.org/cabal/users-guide/++name:                annotated-fix+version:             0.1.0.0+synopsis:            A fixpoint of a functor that can be annotated+description:         This library exposes a type representing the fixpoint+                     of a functor, with an annotation at every node.+-- bug-reports:+license:             BSD3+license-file:        LICENSE+author:              Guerric Chupin+maintainer:          guerric.chupin@gmail.com+-- copyright:+category:            Data+build-type:          Simple+extra-source-files:  CHANGELOG.md++source-repository head+  type:     git+  location: https://gitlab.com/chupin/annotated-fix.git++library+  exposed-modules:     Data.Functor.Annotated+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.9 && <5+                     , recursion-schemes >= 5 && <6+  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Data/Functor/Annotated.hs view

@@ -0,0 +1,102 @@+{-# LANGUAGE DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable,+             FlexibleInstances, TypeFamilies #-}++-- | This modules exposes a type representing the fixpoint of a functor type,+-- paired with an annotation. It exports the recursion-schemes instances for+-- this type and a few specific utility functions.+--+-- = Motivation+--+-- Suppose one has an Abstract Syntax Tree (AST) for the lambda calculus:+--+-- > data Term = Var String | App Term Term | Lam String Term+--+-- Such a type can easily be used with the recursion-schemes library, but it is+-- not always convenient to use this type. It is often the case that one wants+-- to add extra informations to every node of an AST, such as location or type+-- information. In this case, instead of adding those informations as an+-- extra-field to all data constructors, one could prefer to represent terms as+-- a record of a descriptor and the information present at every node, like so:+--+-- > data TermDesc = Var String | App Term Term | Lam String Term+-- > data Term = Term { termDesc :: TermDesc+-- >                  , termTyp  :: Typ+-- >                  , termLoc  :: Loc+-- >                  , ...+-- >                  }+--+-- This library implements this general pattern through the 'Annot' type,+-- representing the fixpoint of a functor type, paired with some annotation. In+-- this setting, the above example would be represented like so:+--+-- > data TermDesc r = Var String | App r r | Lam String r+-- >+-- > data TermAnn = TermAnn { termTyp :: Typ+-- >                        , termLoc :: Loc+-- >                        , ...+-- >                        }+-- >+-- > type Term = Annot TermDesc TermAnn++module Data.Functor.Annotated where++import Data.Functor.Foldable+import GHC.Generics++-- | The fixpoint type of functor @f@, with some annotation @a@.+data Annot f a = Annot a (f (Annot f a))+               deriving( Generic+                       , Functor+                       , Foldable+                       , Traversable+                       )++type instance Base (Annot f a) = f++instance Functor f => Recursive (Annot f a) where+  project = strip++-- ** Annotating and deannotating++-- | Strips one level of annotation+strip :: Annot f a -> f (Annot f a)+strip (Annot _ d) = d++-- | Extracts the annotation+annotation :: Annot f a -> a+annotation (Annot a _) = a++-- | Annotates all the node of a functor's fixpoint value+annotate :: Functor f => (f (Annot f a) -> a) -> Fix f -> Annot f a+annotate = annotateRec++-- | Generalized version of 'annotate' for instances of 'Recursive'+annotateRec :: Recursive t+            => (Base t (Annot (Base t) a) -> a)+            -> t+            -> Annot (Base t) a+annotateRec ann = cata aux+  where aux d = Annot (ann d) d++-- | Strips all annotations+deannotate :: Functor f => Annot f a -> Fix f+deannotate = deannotateCorec++-- | Generalized version of 'deannotate' for instances of 'Corecursive'+deannotateCorec :: Corecursive t => Annot (Base t) a -> t+deannotateCorec = embed . fmap deannotateCorec . strip++-- ** Specific schemes++-- | 'cata'morphism with access to the current annotation+cataAnn :: Functor f => (a -> f b -> b) -> Annot f a -> b+cataAnn fun = paraAnn (\a ffaab -> fun a (fmap snd ffaab))++-- | 'para'morphism with access to the current annotation+paraAnn :: Functor f+        => (a -> f (Annot f a, b) -> b)+        -> Annot f a+        -> b+paraAnn fun ann = para aux ann (annotation ann)+  where aux fafaab a =+          fun a (fmap (\(afa, ab) -> (afa, ab (annotation afa))) fafaab)