preview (empty) → 0.1.0.4
raw patch · 5 files changed
+384/−0 lines, 5 filesdep +basedep +containersdep +prettysetup-changed
Dependencies added: base, containers, pretty, strict-data, text, util-plus
Files
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- preview.cabal +29/−0
- src/Data/Preview.hs +322/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright factis research GmbH (c) 2017++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 Kierán Meinhardt 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 @@+# preview
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ preview.cabal view
@@ -0,0 +1,29 @@+name: preview+version: 0.1.0.4+synopsis: The method of previewing data (instead of wholly show-ing it)+description: The method of previewing data (instead of wholly show-ing it)+homepage: https://github.com/factisresearch/opensource-mono#readme+license: BSD3+license-file: LICENSE+author: factis research GmbH+maintainer: kieran.meinhardt@gmail.com+copyright: 2017 factis research GmbH+category: Data+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Data.Preview+ build-depends: base >= 4.7 && < 5+ , containers+ , pretty+ , strict-data+ , text+ , util-plus+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/factisresearch/opensource-mono
+ src/Data/Preview.hs view
@@ -0,0 +1,322 @@++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+module Data.Preview+ (Preview(..), preview, previewNamedSet, previewNamedList, previewList+ ,previews, previewRec ,previewRec', previewKv, showKv+ ,previewElems, previewsElems, pprMapping, previewList', previewsPrecMapping+ ,Ppr(..), Ppr'(..), Doc, pretty, prettyText, docFromStr, shortPreviewStr+ ,docFromText,angles+ )+where++import Data.Bifunctor+import Data.Choice (Choice(..), mergeChoice)+import Data.Fail (Fail(..))+import Data.List.Plus+import Data.Option (Option(..))+import Data.StrictList (StrictList, toLazyList)+import Data.StrictTuple (Pair(..))+import qualified Data.Map.Ordered as OM+import qualified Data.Map.Unordered as UM++import Data.Int (Int32, Int64)+import Data.Map (Map)+import Data.Maybe (fromMaybe)+import Data.Set (Set)+import Data.Word (Word8, Word64)+import Text.PrettyPrint.HughesPJ (Doc, (<>), (<+>))+import qualified Data.Foldable as F+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Text.PrettyPrint.HughesPJ as P++_LIST_PREVIEW_ELEMS_ :: Int+_LIST_PREVIEW_ELEMS_ = 10++-- | Conversion of values to short readable strings.+-- Preview allows defining short and readable representations of potentially huge data structures+-- that can be used in logs for example. E.g. the Preview instance for lists may only print the+-- values at the beginning of the list and omit the rest.+class Preview a where+ -- | Create a preview String for the given value.+ --+ -- 'previewsPrec' should satisfy the law+ --+ -- > previewsPrec d x r ++ s == previewsPrec d x (r ++ s)+ previewsPrec+ :: Int+ -- ^ The operator precedence of the enclosing context (a number from 0 to 11). Function+ -- application has precedence 10.+ -> a -- ^ the value to be previewed+ -> String -- ^ the string to be appended at the end of the output (for constant time append)+ -> String++instance Preview () where previewsPrec = showsPrec+instance Preview Char where previewsPrec = showsPrec+instance Preview Int where previewsPrec = showsPrec+instance Preview Bool where previewsPrec = showsPrec+instance Preview a => Preview [a] where previewsPrec = previewList+instance Preview T.Text where previewsPrec = previewsText++instance Ppr T.Text where+ ppr = P.text . T.unpack++instance (Preview a, Preview b) => Preview (Either a b) where+ previewsPrec prec eAB s =+ case eAB of+ Left a -> previewsPrec prec a s+ Right b -> previewsPrec prec b s++instance (Preview a) => Preview (Maybe a) where+ previewsPrec prec mA s =+ case mA of+ Nothing -> showString "Nothing" s+ Just a -> previewsPrec prec a s++instance (Preview a, Preview b) => Preview (a, b) where+ previewsPrec prec (a, b) =+ showParen (prec >= 10) $+ previewsPrec 5 a .+ showString ", " .+ previewsPrec 5 b++instance (Preview a, Preview b, Preview c) => Preview (a, b, c) where+ previewsPrec prec (a, b, c) =+ showString "(" .+ previewsPrec prec a .+ showString ", " .+ previewsPrec prec b .+ showString ", " .+ previewsPrec prec c .+ showString ")"++instance Preview Word8 where+ previewsPrec = showsPrec++instance Preview Word64 where+ previewsPrec = showsPrec++instance Preview Int32 where+ previewsPrec = showsPrec++instance Preview Int64 where+ previewsPrec = showsPrec++instance (Preview k, Preview v) => Preview (Map k v) where+ previewsPrec p = previewsPrecMapping p . Map.toList++instance Preview a => Preview (Fail a) where+ previewsPrec p x =+ case x of+ Err msg -> showParen (p > 10) $ showString "Fail " . showsPrec 5 msg+ Ok a -> previewsPrec p a++instance (Preview a, Preview b) => Preview (Pair a b) where+ previewsPrec p (x :!: y) = previewsPrec p (x, y)++instance (Ppr a, Ppr b) => Ppr (Pair a b) where+ ppr (a :!: b) = P.parens ((ppr a <> P.semi) P.<+> ppr b)++instance Preview a => Preview (Option a) where+ previewsPrec prec mA s =+ case mA of+ None -> showsPrec prec ("None"::String) s+ Some a -> previewsPrec prec a s++instance Preview a => Preview (StrictList a) where+ previewsPrec x y = previewList x (toLazyList y)++instance Ppr a => Ppr (StrictList a) where+ ppr = pprMany++instance Ppr a => Ppr (Option a) where+ ppr None = P.text "None"+ ppr (Some a) = ppr a++instance (Preview a, Preview b) => Preview (Choice a b) where+ previewsPrec p choice =+ case choice of+ This a -> previewsPrec p a+ That b -> previewsPrec p b++instance (Preview k, Preview v) => Preview (OM.OSMap k v) where+ previewsPrec p x = previewsPrec p (OM.toDataMap x)++previewsPrecMapping :: (Preview k, Preview v) => t -> [(k, v)] -> String -> String+previewsPrecMapping _ =+ (showString "{ " .) .+ foldr (.) (showString "}") .+ intersperse (showString "\n, ") .+ map (\(k,xs) -> previewsPrec 10 k . showString " -> " . previewsPrec 10 xs) .+ take _LIST_PREVIEW_ELEMS_++class Ppr a where+ ppr :: a -> Doc+ pprMany :: Foldable f => f a -> Doc+ pprMany xs = P.brackets (P.sep $ P.punctuate P.comma $ fmap ppr (F.toList xs))++class Ppr' k where+ ppr' :: Ppr a => k a -> Doc++instance Ppr () where+ ppr () = P.text "()"++instance Ppr Int64 where+ ppr i = P.text (show i)++instance Ppr Char where+ ppr = P.char+ pprMany xs = P.char '"' <> F.foldl' (\d x -> d <> ppr x) P.empty xs <> P.char '"'++instance Ppr Bool where+ ppr x = if x then P.text "True" else P.text "False"++instance Ppr a => Ppr [a] where+ ppr = pprMany++instance Ppr a => Ppr (Set a) where+ ppr = pprMany++instance (Ppr a, Ppr b) => Ppr (Map a b) where+ ppr = pprMapping . Map.toList++instance Ppr Doc where+ ppr = id++instance Ppr a => Ppr (Fail a) where+ ppr (Ok x) = "Ok" <+> ppr x+ ppr (Err msg) = "Fail" <+> docFromStr (show msg)++pprMapping :: (Ppr a, Ppr b) => [(a, b)] -> Doc+pprMapping xs =+ P.braces (P.sep $ P.punctuate P.comma $ fmap pprTuple xs)+ where+ pprTuple (a, b) = P.sep [ppr a <+> P.text "->", P.nest 4 $ ppr b]++instance (Ppr a, Ppr b) => Ppr (a, b) where+ ppr (a, b) = P.parens (ppr a <> P.comma <+> ppr b)++instance Ppr Int where+ ppr = docFromStr . show++instance Ppr Integer where+ ppr = docFromStr . show++instance Ppr Int32 where+ ppr = docFromStr . show++instance Ppr Word8 where+ ppr = docFromStr . show++instance Ppr Double where+ ppr = docFromStr . show++instance Ppr a => Ppr (Maybe a) where+ ppr (Just x) = ppr x+ ppr Nothing = P.text "Nothing"++instance Ppr Word64 where+ ppr = docFromStr . show++instance (Ppr k, Ppr v) => Ppr (OM.OSMap k v) where+ ppr = pprMapping . OM.toList++instance (Ppr k, Ppr v) => Ppr (UM.USMap k v) where+ ppr = pprMapping . UM.toList++instance (Ppr a, Ppr b) => Ppr (Choice a b) where+ ppr = mergeChoice . bimap ppr ppr++pretty :: Ppr a => a -> String+pretty = P.renderStyle (P.style { P.mode = P.LeftMode }) . ppr++prettyText :: Ppr a => a -> T.Text+prettyText = T.pack . pretty++docFromStr :: String -> Doc+docFromStr = P.text++docFromText :: T.Text -> Doc+docFromText = P.text . T.unpack++preview :: Preview a => a -> String+preview x = previewsPrec 5 x ""++previews :: Preview a => a -> String -> String+previews = previewsPrec 0++previewRec :: Int -> String -> [(String, Int -> String -> String)] -> String -> String+previewRec prec tyName fields =+ previewRec' prec tyName (map mapField fields)+ where+ mapField (n,f) = showString n . showString "=" . f 11++previewRec' :: Int -> String -> [String -> String] -> String -> String+previewRec' prec tyName fields =+ showParen (prec > 10) $+ showString tyName .+ showString " { " .+ foldl' (.) id (intersperse (showString ", ") fields) .+ showString " }"++previewKv :: Preview a => String -> a -> String -> String+previewKv name x =+ showString name . showString "=" . (previewsPrec 5 x)++showKv :: Show a => String -> a -> String -> String+showKv name x =+ showString name . showString "=" . (showsPrec 5 x)++previewNamedSet :: String -> t -> Set a -> String -> String+previewNamedSet name _prec set =+ showString "|" . showString name . showString "|=" . showString (show (Set.size set))++previewNamedList :: String -> t -> [a] -> String -> String+previewNamedList name _prec xs =+ showString "|" . showString name . showString "|=" . showString (show (length xs))++previewList' :: Preview a => Maybe Int -> Int -> [a] -> String -> String+previewList' maxElems _prec xs =+ case xs of+ [] -> showString "[]"+ (x:rest)+ | maxElems == Nothing || length xs <= fromMaybe 0 maxElems ->+ showString "[" .+ foldl' (.) id (intersperse (showString ", ") (map (previewsPrec 11) xs)) .+ showString "]"+ | otherwise ->+ showString "[" .+ previewsPrec 5 x .+ if null rest+ then showString "]"+ else showString "... " .+ showsPrec 5 (length rest) .+ showString " more elems)]"++previewList :: Preview a => Int -> [a] -> String -> String+previewList = previewList' (Just _LIST_PREVIEW_ELEMS_)++previewsElems :: (Foldable f, Preview a) => Int -> f a -> String -> String+previewsElems _prec xs =+ showString "[" .+ foldl' (.) id (intersperse (showString ", ") (map (previewsPrec 5) (F.toList xs))) .+ showString "]"++previewElems :: (Foldable t, Preview a) => t a -> String+previewElems xs = previewsElems 5 xs ""++previewsText :: Int -> T.Text -> ShowS+previewsText _ t+ | T.length t < 65 = showString (T.unpack t)+ | otherwise = showString (T.unpack (T.take 65 t)) . showString "..."++shortPreviewStr :: Int -> String -> String+shortPreviewStr n s =+ if length s <= n+ then s+ else take n s ++ "..."++angles :: Doc -> Doc+angles p = P.char '<' <> p <> P.char '>'