panpipe: 662da1e988d2665cc560c7755f6c7ddc29bb4cb0

     1: {-# LANGUAGE OverloadedStrings #-}
     2: import           Control.Applicative
     3: import           Data.Maybe
     4: import qualified Data.Text as T
     5: import           PanPipe
     6: import           Text.Pandoc
     7: import           Test.QuickCheck (Arbitrary, arbitrary, shrink)
     8: import           Test.Tasty (defaultMain, testGroup)
     9: import           Test.Tasty.QuickCheck (testProperty)
    10: 
    11: u = undefined
    12: 
    13: (+++) = T.append
    14: 
    15: pipeBPass p s a1 a2 = let at x  = (u, u, a1 ++ x ++ a2)
    16:                           f a b = [T.pack a +++ b]
    17:                           [CodeBlock _ lhs] = pipeBWith f
    18:                                                 (CodeBlock (at [("pipe", p)]) s)
    19:                       in  lhs == p +++ s
    20: 
    21: pipeBAttr i c a1 a2 = let at x = (i, c, a1 ++ x ++ a2)
    22:                           [CodeBlock as _] = pipeBWith (\_ _ -> [u])
    23:                                                (CodeBlock (at [("pipe", u)])
    24:                                                                   u)
    25:                       in  at [] == as
    26: 
    27: pipeIPass p s a1 a2 = let at x  = (u, u, a1 ++ x ++ a2)
    28:                           f a b = [T.pack a +++ b]
    29:                           [Code _ lhs] = pipeIWith f (Code (at [("pipe", p)]) s)
    30:                       in  lhs == p +++ s
    31: 
    32: pipeIAttr i c a1 a2 = let at x = (i, c, a1 ++ x ++ a2)
    33:                           [Code as _] = pipeIWith (\_ _ -> [u])
    34:                                                   (Code (at [("pipe", u)])
    35:                                                         u)
    36:                       in at [] == as
    37: 
    38: nonPipe as = isNothing $ partPipes (u, u, filter ((/= "pipe") . fst) as)
    39: 
    40: pipeClass p as = (snd <$> partPipes (u, u, ("pipe", p):as)) == Just p
    41: 
    42: main = defaultMain $ testGroup "All tests"
    43:        [
    44:          testProperty "pipeB passes pipe and stdin properly" pipeBPass
    45:        , testProperty "pipeB leaves attributes intact"       pipeBAttr
    46:        , testProperty "pipeI passes pipe and stdin properly" pipeIPass
    47:        , testProperty "pipeI leaves attributes intact"       pipeIAttr
    48:        , testProperty "non-pipes ignored"                    nonPipe
    49:        , testProperty "pipe class found"                     pipeClass
    50:        ]
    51: 
    52: instance Arbitrary T.Text where
    53:   arbitrary = T.pack <$> arbitrary
    54:   shrink x  = map T.pack (shrink (T.unpack x))