packages feed

descript-lang-0.2.0.0: src/Descript/Misc/Build/Write/Print/PrintReduce.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Descript.Misc.Build.Write.Print.PrintReduce
  ( reducePrint
  , reducePrintF
  ) where

import Descript.Misc.Build.Write.Print.Printable
import Descript.Misc.Build.Write.Print.APrint
import Data.List
import Data.String

newtype ReducePrint
  = ReducePrint{ runReducePrint :: String }
  deriving (Eq, Ord, Read, Show, Monoid)

instance IsString ReducePrint where
  fromString ", " = ReducePrint ""
  fromString x = ReducePrint x

instance APrint ReducePrint where
  plex = ReducePrint

  pimp _ = ReducePrint ""

  pintercal (ReducePrint sep) = ReducePrint . intercalate sep . map runReducePrint

-- | Prints this node so that, for a limited ("well-styled") grammar,
-- it's guarenteed to be a subsequence of the text it was parsed from.
-- If @str@ is of this grammar, and @parse@ parses @str@, then:
--
-- > reducePrint (parse str) `isSubsequenceOf` str
--
-- Unprintable text or data which could be parsed multiple ways will
-- be completely excluded. This is used to test parsing.
reducePrint :: (Printable a) => a an -> String
reducePrint = runReducePrint . aprint

-- | Prints the nodes so that, for a limited ("well-styled") grammar,
-- the output is guarenteed to be subsequence of the text the nodes were
-- parsed from.
-- The grammar is even weaker than 'reducePrint', since 'reducePrint'
-- excludes values which have no location.
reducePrintF :: (Foldable w, Printable a) => w (a an) -> String
reducePrintF = foldMap reducePrint