prologue 3.2.3 → 3.2.4
raw patch · 4 files changed
+166/−24 lines, 4 filesdep +pretty
Dependencies added: pretty
Files
- prologue.cabal +4/−3
- src/Prologue.hs +1/−1
- src/Prologue/Data/Basic.hs +18/−4
- src/Prologue/Text/Show/Styled.hs +143/−16
prologue.cabal view
@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack ----- hash: 496b37f67c88f6d5147679947f05f3f1d0999ed2cb39f2fa5acfd7bd67a4c0ff+-- hash: 6c94e687b54e5280348867eb1b00999da64b80bf322aab6e0fd28238404a05bd name: prologue-version: 3.2.3+version: 3.2.4 synopsis: Better, more general Prelude exporting common utilities. description: Replacement for the Haskell's Prelude, exposing more commonly used functions and patching old GHC ones to behave in the newest GHC's way. category: control@@ -53,6 +53,7 @@ , neat-interpolation , placeholders , pointed+ , pretty , pretty-show , primitive , raw-strings-qq
src/Prologue.hs view
@@ -40,7 +40,7 @@ ) import Text.Read as X (readPrec) -- new style Read class implementation import Prologue.Text.Show as X-import Prologue.Text.Show.Styled as X+import Prologue.Text.Show.Styled as X import Text.Show.Functions as X () import Data.Void as X (Void, absurd)
src/Prologue/Data/Basic.hs view
@@ -19,7 +19,9 @@ , Ord (compare, (<), (<=), (>), (>=), max, min) , fst, snd )+import Control.Monad + -- === Utils === -- swap :: (a,b) -> (b,a)@@ -68,12 +70,24 @@ ifThenElse :: Bool -> a -> a -> a ifThenElseId :: Bool -> (a -> a) -> (a -> a) ifThenMempty :: (Mempty a) => Bool -> a -> a-ifThenElse cond ok fl = if cond then ok else fl ; {-# INLINE ifThenElse #-}-ifThenElseId cond f = if cond then f else id ; {-# INLINE ifThenElseId #-}-ifThenMempty cond ok = if cond then ok else mempty ; {-# INLINE ifThenMempty #-}+ifThenElse cond ok fl = if cond then ok else fl +ifThenElseId cond f = if cond then f else id +ifThenMempty cond ok = if cond then ok else mempty +{-# INLINE ifThenElse #-}+{-# INLINE ifThenElseId #-}+{-# INLINE ifThenMempty #-} +ifM :: Monad m => m Bool -> m a -> m a -> m a+ifM = \mcond ok fail -> mcond >>= (\cond -> if cond then ok else fail)+{-# INLINE ifM #-}+ switch :: a -> a -> Bool -> a-switch ok fail cond = if cond then ok else fail ; {-# INLINE switch #-}+switch = \ok fail cond -> ifThenElse cond ok fail+{-# INLINE switch #-}++switchM :: Monad m => m a -> m a -> m Bool -> m a+switchM = \ok fail mcond -> ifM mcond ok fail +{-# INLINE switchM #-} -- === List-like manipulation === --
src/Prologue/Text/Show/Styled.hs view
@@ -1,13 +1,26 @@-{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE AllowAmbiguousTypes #-} module Prologue.Text.Show.Styled where -import Prelude+import Prelude hiding (Monoid) -import Data.Text (Text)+import qualified Data.Text.IO as Text+import qualified Text.Show.Pretty as Formatted+import qualified Text.PrettyPrint as Formatted +import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Text (Text)+import Data.Convert+import Data.Monoids (Monoid, intercalate)+import Data.String (IsString) +-- TODO +-- We should replace Text with some TextBuilder + Cache, which will+-- automatically replace Text.Builders with new one after Text chunks +-- concatenation.+ ------------------- -- === Class === -- -------------------@@ -16,7 +29,7 @@ type family StyledShowOutput style -class StyledShow style a where +class StyledShow style a where styledShow :: style -> a -> StyledShowOutput style class StyledShow1 style a where@@ -38,18 +51,132 @@ ------------------------ === Styles === -----------------------+--------------------------------+-- === Monadic StyledShow === --+-------------------------------- --- === Pretty === --+-- === Definition === -- -data Pretty = Pretty deriving (Show)-type PrettyShow = StyledShow Pretty-type PrettyShow1 = StyledShow1 Pretty-type instance StyledShowOutput Pretty = Text+class StyledShowM style a m where+ styledShowM :: style -> a -> m (StyledShowOutput style)+ +class StyledShowM1 style a m where+ styledShowM1 :: ∀ t1. style -> a t1 -> m (StyledShowOutput style)+ +class StyledShowM2 style a m where+ styledShowM2 :: ∀ t1 t2. style -> a t1 t2 -> m (StyledShowOutput style) -prettyShow :: PrettyShow a => a -> Text-prettyShow1 :: PrettyShow1 a => a t1 -> Text-prettyShow = styledShow Pretty ; {-# INLINE prettyShow #-}-prettyShow1 = styledShow1 Pretty ; {-# INLINE prettyShow1 #-}+ +-- === Redirect instances === --++instance {-# OVERLAPPABLE #-} StyledShowM1 style a m + => StyledShowM style (a t) m where+ styledShowM = styledShowM1 ; {-# INLINE styledShowM #-}++instance {-# OVERLAPPABLE #-} StyledShowM2 style a m + => StyledShowM1 style (a t) m where+ styledShowM1 = styledShowM2 ; {-# INLINE styledShowM1 #-}+++++-----------------------+-- === Formatted === --+-----------------------++-- TODO+-- We should change the whole printing API to use Text instead++format__ :: Text -> Text+format__ txt = convert . show $ case Formatted.parseValue s of+ Just v -> Formatted.valToDoc v+ Nothing -> Formatted.text s+ where s = convert txt+{-# INLINE format__ #-}++putLnFmtd :: MonadIO m => Text -> m ()+putLnFmtd = liftIO . Text.putStrLn . format__++++-----------------------------+-- === StructShowStyle === --+-----------------------------++-- === Definition === --++data StructShowStyle = StructShowStyle deriving (Show)+type instance StyledShowOutput StructShowStyle = Text++type StructShow = StyledShow StructShowStyle+type StructShow1 = StyledShow1 StructShowStyle+type StructShow2 = StyledShow2 StructShowStyle++type StructShowM = StyledShowM StructShowStyle+type StructShowM1 = StyledShowM1 StructShowStyle+type StructShowM2 = StyledShowM2 StructShowStyle++-- TODO+-- We should rename all 'structShowX' functions to just 'showX' and replace all+-- usages of 'show' with it, because using Strings is not good here.+structShow :: StructShow a => a -> Text+structShow1 :: StructShow1 a => a t1 -> Text+structShow2 :: StructShow2 a => a t1 t2 -> Text+structShow = styledShow StructShowStyle ; {-# INLINE structShow #-}+structShow1 = styledShow1 StructShowStyle ; {-# INLINE structShow1 #-}+structShow2 = styledShow2 StructShowStyle ; {-# INLINE structShow2 #-}++showM :: StructShowM a m => a -> m Text+showM1 :: StructShowM1 a m => a t1 -> m Text+showM2 :: StructShowM2 a m => a t1 t2 -> m Text+showM = styledShowM StructShowStyle ; {-# INLINE showM #-}+showM1 = styledShowM1 StructShowStyle ; {-# INLINE showM1 #-}+showM2 = styledShowM2 StructShowStyle ; {-# INLINE showM2 #-}+++-- === Instances === --++instance + ( out ~ StyledShowOutput style+ , Monad m+ , Monoid out+ , IsString out+ , StyledShowM style a m+ ) => StyledShowM style [a] m where+ styledShowM style a = lstfmt <$> mapM (styledShowM style) a where+ lstfmt = braced . intercalate ","+ braced = \a -> "[" <> a <> "]"+++ +-----------------------------+-- === PrettyShowStyle === --+-----------------------------++-- === Definition === --++data PrettyShowStyle = PrettyShowStyle deriving (Show)+type instance StyledShowOutput PrettyShowStyle = Text++type PrettyShow = StyledShow PrettyShowStyle+type PrettyShow1 = StyledShow1 PrettyShowStyle+type PrettyShow2 = StyledShow2 PrettyShowStyle++type PrettyShowM = StyledShowM PrettyShowStyle+type PrettyShowM1 = StyledShowM1 PrettyShowStyle+type PrettyShowM2 = StyledShowM2 PrettyShowStyle++prettyShow :: PrettyShow a => a -> Text+prettyShow1 :: PrettyShow1 a => a t1 -> Text+prettyShow2 :: PrettyShow2 a => a t1 t2 -> Text+prettyShow = styledShow PrettyShowStyle ; {-# INLINE prettyShow #-}+prettyShow1 = styledShow1 PrettyShowStyle ; {-# INLINE prettyShow1 #-}+prettyShow2 = styledShow2 PrettyShowStyle ; {-# INLINE prettyShow2 #-}++prettyShowM :: PrettyShow a => a -> Text+prettyShowM1 :: PrettyShow1 a => a t1 -> Text+prettyShowM2 :: PrettyShow2 a => a t1 t2 -> Text+prettyShowM = styledShow PrettyShowStyle ; {-# INLINE prettyShowM #-}+prettyShowM1 = styledShow1 PrettyShowStyle ; {-# INLINE prettyShowM1 #-}+prettyShowM2 = styledShow2 PrettyShowStyle ; {-# INLINE prettyShowM2 #-}+