ansi-pretty (empty) → 0.1.0.0
raw patch · 6 files changed
+410/−0 lines, 6 filesdep +aesondep +ansi-wl-pprintdep +arraysetup-changed
Dependencies added: aeson, ansi-wl-pprint, array, base, bytestring, containers, generics-sop, nats, scientific, semigroups, tagged, text, time, unordered-containers, vector
Files
- LICENSE +30/−0
- README.md +5/−0
- Setup.hs +2/−0
- ansi-pretty.cabal +50/−0
- src/Data/List/CommonPrefix.hs +36/−0
- src/Text/PrettyPrint/ANSI/Leijen/AnsiPretty.hs +287/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Futurice++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 Oleg Grenrus 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,5 @@+# ansi-pretty++[](https://travis-ci.org/futurice/haskell-ansi-pretty)+[](http://hackage.haskell.org/package/ansi-pretty)+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ansi-pretty.cabal view
@@ -0,0 +1,50 @@+-- This file has been generated from package.yaml by hpack version 0.7.0.+--+-- see: https://github.com/sol/hpack++name: ansi-pretty+version: 0.1.0.0+synopsis: AnsiPretty for ansi-wl-pprint+description: 'AnsiPretty' type class, more colorful than 'Pretty'.+category: Web+homepage: https://github.com/futurice/haskell-ansi-pretty#readme+bug-reports: https://github.com/futurice/haskell-ansi-pretty/issues+author: Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+license: BSD3+license-file: LICENSE+tested-with: GHC==7.8.4, GHC==7.10.2+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/futurice/haskell-ansi-pretty++library+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ aeson >=0.8 && <0.10+ , ansi-wl-pprint >=0.6 && <0.7+ , array >=0.5 && <0.6+ , base >=4.7 && <4.9+ , bytestring >=0.10 && <0.11+ , containers >=0.5 && <0.6+ , generics-sop >=0.1 && <0.2+ , nats >=1 && <1.1+ , scientific >=0.3 && <0.4+ , semigroups >=0.16 && <0.18+ , tagged >=0.7 && <0.9+ , text >=1.2 && <1.3+ , time >=1.4 && <1.6+ , unordered-containers >=0.2 && <0.3+ , vector >=0.10 && <0.12+ exposed-modules:+ Data.List.CommonPrefix+ Text.PrettyPrint.ANSI.Leijen.AnsiPretty+ default-language: Haskell2010
+ src/Data/List/CommonPrefix.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+-- |+-- Module : Data.List.CommonPrefix+-- License : BSD3+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+module Data.List.CommonPrefix where++import Data.Data (Typeable, Data)+import Data.Semigroup+import GHC.Generics (Generic)++#if !MIN_VERSION_base(4,8,0)+import Data.Foldable (Foldable)+import Data.Traversable (Traversable)+#endif++-- | Longest common prefix of lists.+newtype CommonPrefix a = CommonPrefix [a]+ deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable, Typeable, Data, Generic)++getCommonPrefix :: CommonPrefix a -> [a]+getCommonPrefix (CommonPrefix pfx) = pfx++instance Eq a => Semigroup (CommonPrefix a) where+ CommonPrefix as <> CommonPrefix bs = CommonPrefix (impl as bs)+ where+ impl [] _ = []+ impl _ [] = []+ impl (x:xs) (y:ys)+ | x == y = x : impl xs ys+ | otherwise = []
+ src/Text/PrettyPrint/ANSI/Leijen/AnsiPretty.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- |+-- Module : Text.Pretty.ANSI.Leijen.AnsiPretty+-- License : BSD3+-- Maintainer : Oleg Grenrus <oleg.grenrus@iki.fi>+module Text.PrettyPrint.ANSI.Leijen.AnsiPretty (+ -- * Class+ AnsiPretty(..),+ -- * Generics+ -- ** GHC+ ghcAnsiPretty,+ ghcAnsiPrettyWith,+ -- ** SOP+ sopAnsiPretty,+ sopAnsiPrettyWith,+ sopAnsiPrettyS,+ -- ** Options+ AnsiPrettyOpts(..),+ defAnsiPrettyOpts,+ -- * Re-exports+ -- | 'Text.PrettyPrint.ANSI.Leijen'+ module PP,+ -- ** From generics-sop+ ConstructorName,+ FieldName,+ ) where++import Control.Arrow (first)++import Data.List as L+import Data.List.CommonPrefix (CommonPrefix(CommonPrefix), getCommonPrefix)+import Data.List.NonEmpty as NonEmpty+import qualified Data.Semigroup+import Data.Semigroup hiding (All)+import qualified GHC.Generics as GHC+import Generics.SOP as SOP+import Generics.SOP.GGP as SOP+import Text.PrettyPrint.ANSI.Leijen as PP hiding ((<>), (<$>), semiBraces, Pretty)++#if __HADDOCK__+import qualified Text.PrettyPrint.ANSI.Leijen+#endif++import qualified Data.Foldable as Foldable++-- For instances+import Data.Int+import Data.Word+import Numeric.Natural+import qualified Data.Aeson as Aeson+import qualified Data.Array.IArray as Array+import qualified Data.Array.Unboxed as Array+import qualified Data.HashMap.Lazy as HashMap+import qualified Data.HashSet as HashSet+import qualified Data.IntMap as IntMap+import qualified Data.IntSet as IntSet+import qualified Data.Map as Map+import qualified Data.Ratio as Ratio+import qualified Data.Fixed as Fixed+import qualified Data.Sequence as Seq+import qualified Data.Scientific as Scientfic+import qualified Data.Set as Set+import qualified Data.Tagged as Tagged+import qualified Data.Text as ST+import qualified Data.Text.Lazy as LT+import qualified Data.Time as Time+import qualified Data.Vector as V+import qualified Data.Vector.Storable as S+import qualified Data.Vector.Unboxed as U++-- | Generically derivable colorful analogue of 'Text.PrettyPrint.ANSI.Leijen.Pretty'+class AnsiPretty a where+ ansiPretty :: a -> Doc++ default ansiPretty :: (GHC.Generic a, All2 AnsiPretty (GCode a), GFrom a, GDatatypeInfo a, SingI (GCode a)) => a -> Doc+ ansiPretty = ghcAnsiPretty++ ansiPrettyList :: [a] -> Doc+ ansiPrettyList = encloseSep (dullgreen lbracket) (dullgreen rbracket) (dullgreen colon) . fmap ansiPretty++semiBraces :: [Doc] -> Doc+semiBraces = encloseSep (dullblue lbrace) (dullblue rbrace) (dullblue semi)++commaParens :: [Doc] -> Doc+commaParens = encloseSep (dullblue lparen) (dullblue rparen) (dullblue comma)++prettyNewtype :: ConstructorName -> Doc -> Doc+prettyNewtype = const id++prettyField :: AnsiPretty a => String -> a -> Doc+prettyField name value = black (text name) <+> blue equals <+> ansiPretty value++ansiPrettyNewtype :: AnsiPretty a => String -> a -> Doc+ansiPrettyNewtype name x = hang 2 (cyan (text name)) </> ansiPretty x++ansiPrettyMap :: (AnsiPretty k, AnsiPretty v) => String -> [(k, v)] -> Doc+ansiPrettyMap name kv = hang 2 (cyan (text name)) </> encloseSep (dullgreen lbracket) (dullgreen rbracket) (dullgreen colon) (fmap f kv)+ where f (k, v) = ansiPretty k <+> blue colon <+> ansiPretty v++prettyRecord :: String -> [(FieldName, Doc)] -> Doc+prettyRecord name fields = hang 2 (cyan (text name) </> semiBraces (L.map (uncurry prettyField) fields'))+ where fields' = L.map (first (L.drop (L.length fieldNamePrefix))) fields+ fieldNamePrefix = maybe [] (getCommonPrefix . sconcat) $ (fmap . fmap) (CommonPrefix . fst) (nonEmpty fields)++data AnsiPrettyOpts = AnsiPrettyOpts+ { poPrettyNewtype :: ConstructorName -> Doc -> Doc+ , poPrettyRecord :: ConstructorName -> [(FieldName, Doc)] -> Doc+ }++defAnsiPrettyOpts :: AnsiPrettyOpts+defAnsiPrettyOpts = AnsiPrettyOpts prettyNewtype prettyRecord++-- GHC++ghcAnsiPretty :: forall a. (GHC.Generic a, All2 AnsiPretty (GCode a), GFrom a, GDatatypeInfo a, SingI (GCode a)) => a -> Doc+ghcAnsiPretty = ghcAnsiPrettyWith defAnsiPrettyOpts++ghcAnsiPrettyWith :: forall a. (GHC.Generic a, All2 AnsiPretty (GCode a), GFrom a, GDatatypeInfo a, SingI (GCode a)) => AnsiPrettyOpts -> a -> Doc+ghcAnsiPrettyWith opts x = sopAnsiPrettyS opts (gfrom x) (gdatatypeInfo (Proxy :: Proxy a))++-- SOP++sopAnsiPrettyWith :: forall a. (Generic a, HasDatatypeInfo a, All2 AnsiPretty (Code a)) => AnsiPrettyOpts -> a -> Doc+sopAnsiPrettyWith opts x = sopAnsiPrettyS opts (from x) (datatypeInfo (Proxy :: Proxy a))++sopAnsiPretty :: forall a. (Generic a, HasDatatypeInfo a, All2 AnsiPretty (Code a)) => a -> Doc+sopAnsiPretty = sopAnsiPrettyWith defAnsiPrettyOpts++sopAnsiPrettyS :: (All2 AnsiPretty xss) => AnsiPrettyOpts -> SOP I xss -> DatatypeInfo xss -> Doc+sopAnsiPrettyS opts (SOP (Z (I x :* Nil))) (Newtype _ _ ci) = poPrettyNewtype opts (constructorName ci) (ansiPretty x)+sopAnsiPrettyS opts (SOP (Z xs)) (ADT _ _ (ci :* Nil)) = poPrettyRecord opts (constructorName ci) (gAnsiPrettyP xs (fieldInfo ci))+sopAnsiPrettyS _opts (SOP (Z _ )) _ = error "gAnsiPrettyS: redundant Z case"+sopAnsiPrettyS opts (SOP (S xss)) (ADT m d (_ :* cis)) = sopAnsiPrettyS opts (SOP xss) (ADT m d cis)+sopAnsiPrettyS _opts (SOP (S _)) _ = error "gAnsiPrettyS: redundant S case"++gAnsiPrettyP :: (All AnsiPretty xs) => NP I xs -> NP FieldInfo xs -> [(FieldName, Doc)]+gAnsiPrettyP Nil Nil = []+gAnsiPrettyP (I x :* xs) (FieldInfo fieldName :* fis) = (fieldName, ansiPretty x) : gAnsiPrettyP xs fis+gAnsiPrettyP _ _ = error "gAnsiPrettyP: redundant case"++constructorName :: ConstructorInfo a -> ConstructorName+constructorName (Constructor name) = name+constructorName (Infix name _ _) = name+constructorName (Record name _) = name++fieldInfo :: ConstructorInfo xs -> NP FieldInfo xs+fieldInfo (Constructor _) = constructorFieldInfos 0 sing+fieldInfo (Infix _ _ _) = FieldInfo "_lhs" :* FieldInfo "_rhs" :* Nil+fieldInfo (Record _ fi) = fi++constructorFieldInfos :: forall (xs :: [*]). Int -> Sing xs -> NP FieldInfo xs+constructorFieldInfos _ SNil = Nil+constructorFieldInfos n SCons = FieldInfo ("_" <> show n) :* constructorFieldInfos (n+1) sing++-- Instances++instance AnsiPretty Integer where+ ansiPretty = dullyellow . integer++instance AnsiPretty Int where+ ansiPretty = dullyellow . int++instance AnsiPretty Doc where+ ansiPretty = id++instance AnsiPretty Bool where+ ansiPretty True = dullyellow $ string "True"+ ansiPretty False = dullyellow $ string "False"++instance AnsiPretty Char where+ ansiPretty c = string [c]+ ansiPrettyList = string++instance AnsiPretty a => AnsiPretty [a] where+ ansiPretty = ansiPrettyList++instance AnsiPretty a => AnsiPretty (Maybe a) where+ ansiPretty (Just x) = ansiPretty x+ ansiPretty Nothing = dullcyan (string "Nothing")++instance (AnsiPretty a, AnsiPretty b) => AnsiPretty (Either a b)++-- Tuple+instance (AnsiPretty a, AnsiPretty b) => AnsiPretty (a, b) where+ ansiPretty (a, b) = commaParens [ansiPretty a, ansiPretty b]+instance (AnsiPretty a, AnsiPretty b, AnsiPretty c) => AnsiPretty (a, b, c) where+ ansiPretty (a, b, c) = commaParens [ansiPretty a, ansiPretty b, ansiPretty c]+instance (AnsiPretty a, AnsiPretty b, AnsiPretty c, AnsiPretty d) => AnsiPretty (a, b, c, d) where+ ansiPretty (a, b, c, d) = commaParens [ansiPretty a, ansiPretty b, ansiPretty c, ansiPretty d]+instance (AnsiPretty a, AnsiPretty b, AnsiPretty c, AnsiPretty d, AnsiPretty e) => AnsiPretty (a, b, c, d, e) where+ ansiPretty (a, b, c, d, e) = commaParens [ansiPretty a, ansiPretty b, ansiPretty c, ansiPretty d, ansiPretty e]++-- Word+instance AnsiPretty Word where ansiPretty = dullyellow . integer . toInteger++instance AnsiPretty Word8 where ansiPretty = dullyellow . integer . toInteger+instance AnsiPretty Word16 where ansiPretty = dullyellow . integer . toInteger+instance AnsiPretty Word32 where ansiPretty = dullyellow . integer . toInteger+instance AnsiPretty Word64 where ansiPretty = dullyellow . integer . toInteger++instance AnsiPretty Int8 where ansiPretty = dullyellow . integer . toInteger+instance AnsiPretty Int16 where ansiPretty = dullyellow . integer . toInteger+instance AnsiPretty Int32 where ansiPretty = dullyellow . integer . toInteger+instance AnsiPretty Int64 where ansiPretty = dullyellow . integer . toInteger++instance AnsiPretty Natural where ansiPretty = dullyellow . integer . toInteger++instance Fixed.HasResolution e => AnsiPretty (Fixed.Fixed e) where ansiPretty = dullyellow . text . show+instance (AnsiPretty a, Integral a) => AnsiPretty (Ratio.Ratio a) where+ ansiPretty r = ansiPretty (Ratio.numerator r) <+> dullyellow (char '%') <+> ansiPretty (Ratio.denominator r)++-- Generic instances+instance AnsiPretty a => AnsiPretty (CommonPrefix a)++-- aeson+instance AnsiPretty Aeson.Value where+ ansiPretty (Aeson.Object o) = ansiPretty o+ ansiPretty (Aeson.Array a) = ansiPretty a+ ansiPretty (Aeson.String s) = ansiPretty s+ ansiPretty (Aeson.Number s) = ansiPretty s+ ansiPretty (Aeson.Bool b) = ansiPretty b+ ansiPretty Aeson.Null = cyan (text "Null")++-- array+instance (AnsiPretty i, AnsiPretty e, Array.Ix i) => AnsiPretty (Array.Array i e) where ansiPretty = ansiPrettyMap "Array" . Array.assocs+instance (AnsiPretty i, AnsiPretty e, Array.Ix i, Array.IArray Array.UArray e) => AnsiPretty (Array.UArray i e) where ansiPretty = ansiPrettyMap "UArray" . Array.assocs++-- containers+instance AnsiPretty IntSet.IntSet where+ ansiPretty = ansiPrettyNewtype "IntSet" . IntSet.toList+instance AnsiPretty v => AnsiPretty (IntMap.IntMap v) where+ ansiPretty = ansiPrettyMap "IntMap" . IntMap.toList+instance AnsiPretty a => AnsiPretty (Set.Set a) where+ ansiPretty = ansiPrettyNewtype "Set" . Set.toList+instance (AnsiPretty k, AnsiPretty v) => AnsiPretty (Map.Map k v) where+ ansiPretty = ansiPrettyMap "Map" . Map.toList++instance AnsiPretty a => AnsiPretty (Seq.Seq a) where ansiPretty = ansiPrettyNewtype "Seq" . Foldable.toList++-- semigroups+instance AnsiPretty a => AnsiPretty (NonEmpty a) where+ ansiPretty = ansiPretty . toList++instance AnsiPretty a => AnsiPretty (Min a)+instance AnsiPretty a => AnsiPretty (Max a)+instance AnsiPretty a => AnsiPretty (First a)+instance AnsiPretty a => AnsiPretty (Last a)+instance AnsiPretty m => AnsiPretty (WrappedMonoid m)+instance AnsiPretty a => AnsiPretty (Dual a)+instance AnsiPretty Data.Semigroup.All+instance AnsiPretty Any+instance AnsiPretty a => AnsiPretty (Sum a)+instance AnsiPretty a => AnsiPretty (Product a)+instance AnsiPretty a => AnsiPretty (Option a)+instance (AnsiPretty a, AnsiPretty b) => AnsiPretty (Arg a b)++-- scientific+instance AnsiPretty Scientfic.Scientific where ansiPretty = dullyellow . text . show++-- tagged+instance AnsiPretty a => AnsiPretty (Tagged.Tagged t a) where ansiPretty = ansiPretty . Tagged.untag++-- text+instance AnsiPretty LT.Text where ansiPretty = ansiPretty . LT.unpack+instance AnsiPretty ST.Text where ansiPretty = ansiPretty . ST.unpack++-- time+instance AnsiPretty Time.UTCTime where ansiPretty = ansiPretty . show++-- vector+instance AnsiPretty a => AnsiPretty (V.Vector a) where ansiPretty = ansiPrettyNewtype "Vector" . V.toList+instance (AnsiPretty a, S.Storable a) => AnsiPretty (S.Vector a) where ansiPretty = ansiPrettyNewtype "S.Vector" . S.toList+instance (AnsiPretty a, U.Unbox a) => AnsiPretty (U.Vector a) where ansiPretty = ansiPrettyNewtype "U.Vector" . U.toList++-- unordered-containers+instance AnsiPretty a => AnsiPretty (HashSet.HashSet a) where ansiPretty = ansiPrettyNewtype "HashSet" . HashSet.toList++instance (AnsiPretty k, AnsiPretty v) => AnsiPretty (HashMap.HashMap k v) where+ ansiPretty = ansiPrettyMap "HashMap" . HashMap.toList