diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2014, Well-Typed LLP, Edsko de Vries, Andres Löh +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +2. 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. + +3. Neither the name of the copyright holder nor the names of its 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 HOLDER 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/pretty-sop.cabal b/pretty-sop.cabal new file mode 100644 --- /dev/null +++ b/pretty-sop.cabal @@ -0,0 +1,59 @@ +name: pretty-sop +version: 0.1.0.0 +synopsis: A generic pretty-printer using generics-sop +description: + This library contains a generic implementation of the 'prettyVal' + function from the @@ + package. Using the pretty printer, values can easily be rendered to + strings and HTML documents in a uniform way. + . + This library makes use of the + @@ package and + is an example of a generic function defined in the SOP style. + . +license: BSD3 +license-file: LICENSE +author: Edsko de Vries , Andres Löh +maintainer: edsko@well-typed.com +category: Generics +build-type: Simple +cabal-version: >=1.10 +tested-with: GHC == 7.6.3, GHC == 7.8.2 + +source-repository head + type: git + location: https://github.com/well-typed/pretty-sop + +library + exposed-modules: Generics.SOP.PrettyVal + build-depends: base >= 4.6 && < 5, + generics-sop >= 0.1 && < 0.2, + pretty-show >= 1.6 && < 1.7 + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + default-extensions: ScopedTypeVariables + TypeFamilies + RankNTypes + TypeOperators + GADTs + ConstraintKinds + MultiParamTypeClasses + TypeSynonymInstances + FlexibleInstances + FlexibleContexts + DeriveFunctor + DeriveFoldable + DeriveTraversable + DefaultSignatures + KindSignatures + DataKinds + FunctionalDependencies + if impl (ghc >= 7.8) + default-extensions: AutoDeriveTypeable + other-extensions: OverloadedStrings + OverlappingInstances + PolyKinds + UndecidableInstances + TemplateHaskell + CPP diff --git a/src/Generics/SOP/PrettyVal.hs b/src/Generics/SOP/PrettyVal.hs new file mode 100644 --- /dev/null +++ b/src/Generics/SOP/PrettyVal.hs @@ -0,0 +1,54 @@ +-- | Generic pretty-printer. +-- +-- This module defines a generic function that helps in defining class +-- instances for the 'PrettyVal' class from the @pretty-show@ package. +-- +module Generics.SOP.PrettyVal ( + gprettyVal + -- * Re-exports + , PrettyVal(..) + ) where + +import Text.Show.Pretty + +import Generics.SOP + +-- | Generic pretty-printer. +-- +-- This function turns a value into the uniform representation of type +-- 'Value' that is provided by the @pretty-show@ package. The function +-- has the suitable type to serve as the default implementation of the +-- 'prettyVal' function in the 'PrettyVal' class. +-- +-- If you have a datatype @T@ that is an instance of @generic-sop@'s +-- 'Generic' and 'HasDatatypeInfo' classes, you can use 'gprettyVal' +-- as follows: +-- +-- > instance PrettyVal T where +-- > prettyVal = gprettyVal +-- +gprettyVal :: forall a. (Generic a, HasDatatypeInfo a, All2 PrettyVal (Code a)) => a -> Value +gprettyVal = gprettyVal' (datatypeInfo (Proxy :: Proxy a)) . from + +gprettyVal' :: (All2 PrettyVal xss, SingI xss) => DatatypeInfo xss -> SOP I xss -> Value +gprettyVal' (ADT _ _ cs) = gprettyVal'' cs +gprettyVal' (Newtype _ _ c) = gprettyVal'' (c :* Nil) + +gprettyVal'' :: (All2 PrettyVal xss, SingI xss) => NP ConstructorInfo xss -> SOP I xss -> Value +gprettyVal'' info (SOP sop) = + unI . hcollapse $ hcliftA2' p prettyValFor info sop + +prettyValFor :: All PrettyVal xs => ConstructorInfo xs -> NP I xs -> K Value xs +prettyValFor (Constructor n) = K . Con n . hcollapse . hcliftA p (K . prettyVal . unI) +prettyValFor (Infix n _ _) = K . aux . hcliftA p (K . prettyVal . unI) + where + aux :: forall x y. NP (K Value) '[x, y] -> Value + aux (K x :* K y :* Nil) = InfixCons x [(n, y)] + aux _ = error "inaccessible" +prettyValFor (Record n fs) = K . Rec n . hcollapse . hcliftA2 p aux fs + where + aux :: forall a. PrettyVal a => FieldInfo a -> I a -> K (Name, Value) a + aux (FieldInfo f) (I a) = K (f, prettyVal a) + +p :: Proxy PrettyVal +p = Proxy