{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
-- | promoted read, show, and printf functions

module Predicate.Data.ReadShow (
 -- ** show

    ShowP

 -- ** read

  , ReadP
  , ReadP'
  , ReadMaybe
  , ReadMaybe'

  -- ** print

  , PrintF
  , PrintL
  , PrintT
  , PrintI
  , PrintC (..)
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Data.Tuple (ToITuple, ToITupleList, ReverseITuple)
import GHC.TypeLits (Nat)
import Data.Proxy (Proxy(Proxy))
import Data.Kind (Type)
import Text.Printf (PrintfArg, printf, PrintfType)
import Data.Typeable (Typeable)
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> :set -XNoOverloadedLists

-- >>> import Predicate

-- >>> import Data.Time


-- | similar to 'show'

--

-- >>> pz @(ShowP Id) [4,8,3,9]

-- Val "[4,8,3,9]"

--

-- >>> pz @(ShowP Id) 'x'

-- Val "'x'"

--

-- >>> pz @(ShowP (42 -% 10)) 'x'

-- Val "(-21) % 5"

--

data ShowP p deriving Int -> ShowP p -> ShowS
[ShowP p] -> ShowS
ShowP p -> String
(Int -> ShowP p -> ShowS)
-> (ShowP p -> String) -> ([ShowP p] -> ShowS) -> Show (ShowP p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ShowP p -> ShowS
forall k (p :: k). [ShowP p] -> ShowS
forall k (p :: k). ShowP p -> String
showList :: [ShowP p] -> ShowS
$cshowList :: forall k (p :: k). [ShowP p] -> ShowS
show :: ShowP p -> String
$cshow :: forall k (p :: k). ShowP p -> String
showsPrec :: Int -> ShowP p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ShowP p -> ShowS
Show

instance ( Show (PP p x)
         , P p x
         ) => P (ShowP p) x where
  type PP (ShowP p) x = String
  eval :: proxy (ShowP p) -> POpts -> x -> m (TT (PP (ShowP p) x))
eval proxy (ShowP p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ShowP"
    TT (PP p x)
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT String) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
      Left TT String
e -> TT String
e
      Right PP p x
p ->
        let d :: String
d = PP p x -> String
forall a. Show a => a -> String
show PP p x
p
        in POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val String
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
d String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> PP p x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]

-- | uses the 'Read' of the given type @t@ and @p@ which points to the content to read

data ReadP' t p deriving Int -> ReadP' t p -> ShowS
[ReadP' t p] -> ShowS
ReadP' t p -> String
(Int -> ReadP' t p -> ShowS)
-> (ReadP' t p -> String)
-> ([ReadP' t p] -> ShowS)
-> Show (ReadP' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> ReadP' t p -> ShowS
forall k (t :: k) k (p :: k). [ReadP' t p] -> ShowS
forall k (t :: k) k (p :: k). ReadP' t p -> String
showList :: [ReadP' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [ReadP' t p] -> ShowS
show :: ReadP' t p -> String
$cshow :: forall k (t :: k) k (p :: k). ReadP' t p -> String
showsPrec :: Int -> ReadP' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> ReadP' t p -> ShowS
Show

instance ( P p x
         , PP p x ~ String
         , Typeable (PP t x)
         , Show (PP t x)
         , Read (PP t x)
         ) => P (ReadP' t p) x where
  type PP (ReadP' t p) x = PP t x
  eval :: proxy (ReadP' t p) -> POpts -> x -> m (TT (PP (ReadP' t p) x))
eval proxy (ReadP' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ReadP " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
        t :: String
t = Typeable (PP t x) => String
forall t. Typeable t => String
showT @(PP t x)
    TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t x) -> m (TT (PP t x))) -> TT (PP t x) -> m (TT (PP t x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (PP t x)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT (PP t x)
e -> TT (PP t x)
e
      Right String
s ->
        let hhs :: [Tree PE]
hhs = [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
        in case ReadS (PP t x)
forall a. Read a => ReadS a
reads @(PP t x) String
s of
           [(PP t x
b,String
"")] -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t x -> Val (PP t x)
forall a. a -> Val a
Val PP t x
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ POpts -> PP t x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP t x
b) [Tree PE]
hhs
           [(PP t x, String)]
o -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t x)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")")) (POpts -> String -> [(PP t x, String)] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
"" [(PP t x, String)]
o) [Tree PE]
hhs

-- | uses the 'Read' of the given type @t@ and @p@ which points to the content to read

--

-- >>> pz @(ReadP Rational Id) "4 % 5"

-- Val (4 % 5)

--

-- >>> pz @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2018-10-12"

-- Val True

--

-- >>> pz @(Between (ReadP Day "2017-04-11") (ReadP Day "2018-12-30") (ReadP Day Id)) "2016-10-12"

-- Val False

--

-- >>> pl @(ReadP Rational Id) "123 % 4"

-- Present 123 % 4 (ReadP Ratio Integer 123 % 4)

-- Val (123 % 4)

--

-- >>> pl @(ReadP Rational Id) "x123 % 4"

-- Error ReadP Ratio Integer (x123 % 4) ([])

-- Fail "ReadP Ratio Integer (x123 % 4)"

--

-- >>> pl @(ReadP Day Id) "1999-11-30"

-- Present 1999-11-30 (ReadP Day 1999-11-30)

-- Val 1999-11-30

--

-- >>> pl @(ReadP Day Id) "1999-02-29"

-- Error ReadP Day (1999-02-29) ([])

-- Fail "ReadP Day (1999-02-29)"

--

-- >>> pl @(ReadP TimeOfDay Id) "14:59:20"

-- Present 14:59:20 (ReadP TimeOfDay 14:59:20)

-- Val 14:59:20

--

data ReadP (t :: Type) p deriving Int -> ReadP t p -> ShowS
[ReadP t p] -> ShowS
ReadP t p -> String
(Int -> ReadP t p -> ShowS)
-> (ReadP t p -> String)
-> ([ReadP t p] -> ShowS)
-> Show (ReadP t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> ReadP t p -> ShowS
forall t k (p :: k). [ReadP t p] -> ShowS
forall t k (p :: k). ReadP t p -> String
showList :: [ReadP t p] -> ShowS
$cshowList :: forall t k (p :: k). [ReadP t p] -> ShowS
show :: ReadP t p -> String
$cshow :: forall t k (p :: k). ReadP t p -> String
showsPrec :: Int -> ReadP t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> ReadP t p -> ShowS
Show
type ReadPT (t :: Type) p = ReadP' (Hole t) p

instance P (ReadPT t p) x => P (ReadP t p) x where
  type PP (ReadP t p) x = PP (ReadPT t p) x
  eval :: proxy (ReadP t p) -> POpts -> x -> m (TT (PP (ReadP t p) x))
eval proxy (ReadP t p)
_ = Proxy (ReadPT t p) -> POpts -> x -> m (TT (PP (ReadPT t p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (ReadPT t p)
forall k (t :: k). Proxy t
Proxy @(ReadPT t p))

-- | same as 'ReadMaybe' except @t@ is a pointer to the type

data ReadMaybe' t p deriving Int -> ReadMaybe' t p -> ShowS
[ReadMaybe' t p] -> ShowS
ReadMaybe' t p -> String
(Int -> ReadMaybe' t p -> ShowS)
-> (ReadMaybe' t p -> String)
-> ([ReadMaybe' t p] -> ShowS)
-> Show (ReadMaybe' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> ReadMaybe' t p -> ShowS
forall k (t :: k) k (p :: k). [ReadMaybe' t p] -> ShowS
forall k (t :: k) k (p :: k). ReadMaybe' t p -> String
showList :: [ReadMaybe' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [ReadMaybe' t p] -> ShowS
show :: ReadMaybe' t p -> String
$cshow :: forall k (t :: k) k (p :: k). ReadMaybe' t p -> String
showsPrec :: Int -> ReadMaybe' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> ReadMaybe' t p -> ShowS
Show

instance ( P p x
         , PP p x ~ String
         , Typeable (PP t x)
         , Show (PP t x)
         , Read (PP t x)
         ) => P (ReadMaybe' t p) x where
  type PP (ReadMaybe' t p) x = Maybe (PP t x, String)
  eval :: proxy (ReadMaybe' t p)
-> POpts -> x -> m (TT (PP (ReadMaybe' t p) x))
eval proxy (ReadMaybe' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ReadMaybe " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t
        t :: String
t = Typeable (PP t x) => String
forall t. Typeable t => String
showT @(PP t x)
    TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT (Maybe (PP t x, String)) -> m (TT (Maybe (PP t x, String)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe (PP t x, String)) -> m (TT (Maybe (PP t x, String))))
-> TT (Maybe (PP t x, String)) -> m (TT (Maybe (PP t x, String)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (Maybe (PP t x, String))) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT (Maybe (PP t x, String))
e -> TT (Maybe (PP t x, String))
e
      Right String
s ->
        let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
            hhs :: [Tree PE]
hhs = [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
        in case ReadS (PP t x)
forall a. Read a => ReadS a
reads @(PP t x) String
s of
           [(PP t x
b,String
rest)] -> POpts
-> Val (Maybe (PP t x, String))
-> String
-> [Tree PE]
-> TT (Maybe (PP t x, String))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe (PP t x, String) -> Val (Maybe (PP t x, String))
forall a. a -> Val a
Val ((PP t x, String) -> Maybe (PP t x, String)
forall a. a -> Maybe a
Just (PP t x
b,String
rest))) (POpts -> String -> PP t x -> String -> ShowS
forall a1. Show a1 => POpts -> String -> a1 -> String -> ShowS
lit3 POpts
opts String
msg1 PP t x
b String
"" String
s) [Tree PE]
hhs
           [(PP t x, String)]
o -> POpts
-> Val (Maybe (PP t x, String))
-> String
-> [Tree PE]
-> TT (Maybe (PP t x, String))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe (PP t x, String) -> Val (Maybe (PP t x, String))
forall a. a -> Val a
Val Maybe (PP t x, String)
forall a. Maybe a
Nothing) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" failed" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [(PP t x, String)] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" " [(PP t x, String)]
o) [Tree PE]
hhs

-- | Read but returns the Maybe of the value and any remaining unparsed string

--

-- >>> pz @(ReadMaybe Int Id) "123x"

-- Val (Just (123,"x"))

--

-- >>> pz @(ReadMaybe Int Id) "123"

-- Val (Just (123,""))

--

-- >>> pz @(ReadMaybe Int Id) "x123"

-- Val Nothing

--

data ReadMaybe (t :: Type) p deriving Int -> ReadMaybe t p -> ShowS
[ReadMaybe t p] -> ShowS
ReadMaybe t p -> String
(Int -> ReadMaybe t p -> ShowS)
-> (ReadMaybe t p -> String)
-> ([ReadMaybe t p] -> ShowS)
-> Show (ReadMaybe t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> ReadMaybe t p -> ShowS
forall t k (p :: k). [ReadMaybe t p] -> ShowS
forall t k (p :: k). ReadMaybe t p -> String
showList :: [ReadMaybe t p] -> ShowS
$cshowList :: forall t k (p :: k). [ReadMaybe t p] -> ShowS
show :: ReadMaybe t p -> String
$cshow :: forall t k (p :: k). ReadMaybe t p -> String
showsPrec :: Int -> ReadMaybe t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> ReadMaybe t p -> ShowS
Show
type ReadMaybeT (t :: Type) p = ReadMaybe' (Hole t) p

instance P (ReadMaybeT t p) x => P (ReadMaybe t p) x where
  type PP (ReadMaybe t p) x = PP (ReadMaybeT t p) x
  eval :: proxy (ReadMaybe t p)
-> POpts -> x -> m (TT (PP (ReadMaybe t p) x))
eval proxy (ReadMaybe t p)
_ = Proxy (ReadMaybeT t p)
-> POpts -> x -> m (TT (PP (ReadMaybeT t p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (ReadMaybeT t p)
forall k (t :: k). Proxy t
Proxy @(ReadMaybeT t p))

-- | uses PrintF (unsafe) to format output for a single value

--

-- >>> pz @(PrintF "value=%03d" Id) 12

-- Val "value=012"

--

-- >>> pz @(PrintF "%s" Fst) ("abc",'x')

-- Val "abc"

--

-- >>> pz @(PrintF "%d" Fst) ("abc",'x')

-- Fail "PrintF (IO e=printf: bad formatting char 'd')"

--

-- >>> pl @(PrintF "someval %d" Id) "!23"

-- Error PrintF (IO e=printf: bad formatting char 'd') ("!23" s=someval %d)

-- Fail "PrintF (IO e=printf: bad formatting char 'd')"

--

-- >>> pl @(PrintF "%-6s" Id) 1234

-- Error PrintF (IO e=printf: bad formatting char 's') (1234 s=%-6s)

-- Fail "PrintF (IO e=printf: bad formatting char 's')"

--

-- >>> pl @(PrintF "%06x" Id) 1234

-- Present "0004d2" (PrintF [0004d2] | p=1234 | s=%06x)

-- Val "0004d2"

--

-- >>> pl @(Msg (PrintF "digits=%d" Len) Head) [1..4]

-- Present 1 (digits=4 Head 1 | [1,2,3,4])

-- Val 1

--

-- >>> pl @(PrintF "ask%%dfas%%kef%05d hey %%" Id) 35

-- Present "ask%dfas%kef00035 hey %" (PrintF [ask%dfas%kef00035 hey %] | p=35 | s=ask%%dfas%%kef%05d hey %%)

-- Val "ask%dfas%kef00035 hey %"

--

-- >>> pl @(Fail () (PrintF "someval int=%d" Id)) 45

-- Error someval int=45

-- Fail "someval int=45"

--

data PrintF s p deriving Int -> PrintF s p -> ShowS
[PrintF s p] -> ShowS
PrintF s p -> String
(Int -> PrintF s p -> ShowS)
-> (PrintF s p -> String)
-> ([PrintF s p] -> ShowS)
-> Show (PrintF s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k) k (p :: k). Int -> PrintF s p -> ShowS
forall k (s :: k) k (p :: k). [PrintF s p] -> ShowS
forall k (s :: k) k (p :: k). PrintF s p -> String
showList :: [PrintF s p] -> ShowS
$cshowList :: forall k (s :: k) k (p :: k). [PrintF s p] -> ShowS
show :: PrintF s p -> String
$cshow :: forall k (s :: k) k (p :: k). PrintF s p -> String
showsPrec :: Int -> PrintF s p -> ShowS
$cshowsPrec :: forall k (s :: k) k (p :: k). Int -> PrintF s p -> ShowS
Show

instance ( PrintfArg (PP p x)
         , Show (PP p x)
         , PP s x ~ String
         , P s x
         , P p x
         ) => P (PrintF s p) x where
  type PP (PrintF s p) x = String
  eval :: proxy (PrintF s p) -> POpts -> x -> m (TT (PP (PrintF s p) x))
eval proxy (PrintF s p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"PrintF"
    Either (TT String) (String, PP p x, TT String, TT (PP p x))
lrx <- Inline
-> String
-> Proxy s
-> Proxy p
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT String) (PP s x, PP p x, TT (PP s x), TT (PP p x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy s
forall k (t :: k). Proxy t
Proxy @s) (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x []
    case Either (TT String) (String, PP p x, TT String, TT (PP p x))
lrx of
      Left TT String
e -> TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT String
e
      Right (String
s,PP p x
p,TT String
ss,TT (PP p x)
pp) -> do
        Either String String
lr <- String -> m (Either String String)
forall (m :: Type -> Type) a.
(MonadEval m, NFData a) =>
a -> m (Either String a)
catchitNF (String -> PP p x -> String
forall r. PrintfType r => String -> r
printf String
s PP p x
p)
        TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ case Either String String
lr of
          Left String
e -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")) (POpts -> PP p x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p x
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" s=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
ss, TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
          Right String
ret -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val String
ret) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
ret String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> PP p x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | p=" PP p x
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
" | s=" String
s) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
ss, TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]


-- | uses inductive tuples to replace variable arguments

--

class PrintC (x :: Type) where
  prtC :: (PrintfArg a, PrintfType r) => String -> (a,x) -> r
instance PrintC () where
  prtC :: String -> (a, ()) -> r
prtC String
s (a
a,()) = String -> a -> r
forall r. PrintfType r => String -> r
printf String
s a
a
instance ( PrintfArg a
         , PrintC rs
         ) => PrintC (a,rs) where
  prtC :: String -> (a, (a, rs)) -> r
prtC String
s (a
a,(a, rs)
rs) = String -> (a, rs) -> a -> r
forall x a r.
(PrintC x, PrintfArg a, PrintfType r) =>
String -> (a, x) -> r
prtC String
s (a, rs)
rs a
a

-- | print for flat n-tuples of size two or larger

--

-- >>> pl @(PrintT "%d %s %s %s" '(Fst, Snd, Snd,Snd)) (10,"Asdf")

-- Present "10 Asdf Asdf Asdf" ((>>) "10 Asdf Asdf Asdf" | {PrintI [10 Asdf Asdf Asdf] | s=%d %s %s %s})

-- Val "10 Asdf Asdf Asdf"

--

-- >>> pl @(PrintT "%c %d %s" Id) ('x', 10,"Asdf")

-- Present "x 10 Asdf" ((>>) "x 10 Asdf" | {PrintI [x 10 Asdf] | s=%c %d %s})

-- Val "x 10 Asdf"

--

-- >>> pz @(PrintT "fst=%s snd=%03d" Id) ("ab",123)

-- Val "fst=ab snd=123"

--

-- >>> pz @(PrintT "fst=%s snd=%03d thd=%s" Id) ("ab",123,"xx")

-- Val "fst=ab snd=123 thd=xx"

--

-- >>> pl @(PrintT "%s %d %c %s" '(W "xyz", Fst, Snd, Thd)) (123,'x',"ab")

-- Present "xyz 123 x ab" ((>>) "xyz 123 x ab" | {PrintI [xyz 123 x ab] | s=%s %d %c %s})

-- Val "xyz 123 x ab"

--

-- >>> pl @(PrintT "%d %c %s" Id) (123,'x')

-- Error PrintI(IO e=printf: argument list ended prematurely) (PrintI %d %c %s | ('x',(123,())))

-- Fail "PrintI(IO e=printf: argument list ended prematurely)"

--

-- >>> pl @(PrintT "%d %c %s" Id) (123,'x',"abc",11)

-- Error PrintI(IO e=printf: formatting string ended prematurely) (PrintI %d %c %s | (11,("abc",('x',(123,())))))

-- Fail "PrintI(IO e=printf: formatting string ended prematurely)"

--

-- >>> pl @(PrintT "lhs = %d rhs = %s" Id) (123,"asdf")

-- Present "lhs = 123 rhs = asdf" ((>>) "lhs = 123 rhs = asdf" | {PrintI [lhs = 123 rhs = asdf] | s=lhs = %d rhs = %s})

-- Val "lhs = 123 rhs = asdf"

--

-- >>> pl @(PrintT "d=%03d s=%s" Id) (9,"ab")

-- Present "d=009 s=ab" ((>>) "d=009 s=ab" | {PrintI [d=009 s=ab] | s=d=%03d s=%s})

-- Val "d=009 s=ab"

--

-- >>> pl @(PrintT "d=%03d s=%s c=%c f=%4.2f" Id) (9,"ab",'x',1.54)

-- Present "d=009 s=ab c=x f=1.54" ((>>) "d=009 s=ab c=x f=1.54" | {PrintI [d=009 s=ab c=x f=1.54] | s=d=%03d s=%s c=%c f=%4.2f})

-- Val "d=009 s=ab c=x f=1.54"

--

-- >>> pl @(PrintT "d=%03d s=%s" Id) (9, "ab",'x',1.54)

-- Error PrintI(IO e=printf: formatting string ended prematurely) (PrintI d=%03d s=%s | (1.54,('x',("ab",(9,())))))

-- Fail "PrintI(IO e=printf: formatting string ended prematurely)"

--

-- >>> pl @(PrintT "lhs = %d rhs = %s c=%d" Id) (123,"asdf",'x')

-- Present "lhs = 123 rhs = asdf c=120" ((>>) "lhs = 123 rhs = asdf c=120" | {PrintI [lhs = 123 rhs = asdf c=120] | s=lhs = %d rhs = %s c=%d})

-- Val "lhs = 123 rhs = asdf c=120"

--

-- >>> pl @(PrintT "hello d=%d %c %s" '(12, C "z", "someval")) ()

-- Present "hello d=12 z someval" ((>>) "hello d=12 z someval" | {PrintI [hello d=12 z someval] | s=hello d=%d %c %s})

-- Val "hello d=12 z someval"

--

-- >>> pl @(PrintT "ipaddress %03d.%03d.%03d.%03d" '(1,2,3,4)) ()

-- Present "ipaddress 001.002.003.004" ((>>) "ipaddress 001.002.003.004" | {PrintI [ipaddress 001.002.003.004] | s=ipaddress %03d.%03d.%03d.%03d})

-- Val "ipaddress 001.002.003.004"

--

data PrintT s p deriving Int -> PrintT s p -> ShowS
[PrintT s p] -> ShowS
PrintT s p -> String
(Int -> PrintT s p -> ShowS)
-> (PrintT s p -> String)
-> ([PrintT s p] -> ShowS)
-> Show (PrintT s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k) k (p :: k). Int -> PrintT s p -> ShowS
forall k (s :: k) k (p :: k). [PrintT s p] -> ShowS
forall k (s :: k) k (p :: k). PrintT s p -> String
showList :: [PrintT s p] -> ShowS
$cshowList :: forall k (s :: k) k (p :: k). [PrintT s p] -> ShowS
show :: PrintT s p -> String
$cshow :: forall k (s :: k) k (p :: k). PrintT s p -> String
showsPrec :: Int -> PrintT s p -> ShowS
$cshowsPrec :: forall k (s :: k) k (p :: k). Int -> PrintT s p -> ShowS
Show
type PrintTT s p = p >> ToITuple >> ReverseITuple >> PrintI s

instance P (PrintTT s p) x => P (PrintT s p) x where
  type PP (PrintT s p) x = PP (PrintTT s p) x
  eval :: proxy (PrintT s p) -> POpts -> x -> m (TT (PP (PrintT s p) x))
eval proxy (PrintT s p)
_ = Proxy (PrintTT s p) -> POpts -> x -> m (TT (PP (PrintTT s p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (PrintTT s p)
forall k (t :: k). Proxy t
Proxy @(PrintTT s p))

-- | prints inductive tuples in reverse order

--

-- >>> pz @(PrintI "d=%d s=%s f=%f") (1.73,("abc",(12,())))

-- Val "d=12 s=abc f=1.73"

--

-- >>> pz @(PrintI "d=%d s=%s f=%f") ("abc",(12,()))

-- Fail "PrintI(IO e=printf: argument list ended prematurely)"

--

-- >>> pz @(PrintI "d=%s s=%d") ("abc",('x',()))

-- Fail "PrintI(IO e=printf: bad formatting char 's')"

--

-- >>> pz @(PrintI "%s %s %d") (123,("sss",("bb",())))

-- Val "bb sss 123"

--

data PrintI s deriving Int -> PrintI s -> ShowS
[PrintI s] -> ShowS
PrintI s -> String
(Int -> PrintI s -> ShowS)
-> (PrintI s -> String) -> ([PrintI s] -> ShowS) -> Show (PrintI s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k). Int -> PrintI s -> ShowS
forall k (s :: k). [PrintI s] -> ShowS
forall k (s :: k). PrintI s -> String
showList :: [PrintI s] -> ShowS
$cshowList :: forall k (s :: k). [PrintI s] -> ShowS
show :: PrintI s -> String
$cshow :: forall k (s :: k). PrintI s -> String
showsPrec :: Int -> PrintI s -> ShowS
$cshowsPrec :: forall k (s :: k). Int -> PrintI s -> ShowS
Show
instance ( PrintC bs
         , (b,bs) ~ x
         , PrintfArg b
         , PP s x ~ String
         , P s x
         ) => P (PrintI s) x where
  type PP (PrintI s) x = String
  eval :: proxy (PrintI s) -> POpts -> x -> m (TT (PP (PrintI s) x))
eval proxy (PrintI s)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"PrintI"
    TT String
ss <- Proxy s -> POpts -> x -> m (TT (PP s x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy s
forall k (t :: k). Proxy t
Proxy @s) POpts
opts x
x
    case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT String) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
ss [] of
      Left TT String
e -> TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT String
e
      Right String
s -> do
        let hhs :: [Tree PE]
hhs = [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
ss]
        Either String String
lr <- String -> m (Either String String)
forall (m :: Type -> Type) a.
(MonadEval m, NFData a) =>
a -> m (Either String a)
catchitNF (String -> (b, bs) -> String
forall x a r.
(PrintC x, PrintfArg a, PrintfType r) =>
String -> (a, x) -> r
prtC @bs String
s x
(b, bs)
x)
        TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ case Either String String
lr of
          Left String
e -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s) [Tree PE]
hhs
          Right String
ret -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val String
ret) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
ret String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"] | s=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
s) [Tree PE]
hhs

-- | print for lists  -- use 'PrintT' as it is safer than 'PrintL'

--

-- >>> pl @(PrintL 4 "%s %s %s %s" '[W "xyz", ShowP Fst, ShowP Snd, Thd]) (123,'x',"ab")

-- Present "xyz 123 'x' ab" ((>>) "xyz 123 'x' ab" | {PrintI [xyz 123 'x' ab] | s=%s %s %s %s})

-- Val "xyz 123 'x' ab"

--

-- >>> pz @(PrintL 1 "%05d" '[Id]) 123  -- tick is required for a one element lis)

-- Val "00123"

--

-- >>> pz @(PrintL 2 "%d %05d" [Fst,Snd]) (29,123)

-- Val "29 00123"

--

-- >>> pl @(PrintL 3 "first=%d second=%d third=%d" Id) [10,11,12]

-- Present "first=10 second=11 third=12" ((>>) "first=10 second=11 third=12" | {PrintI [first=10 second=11 third=12] | s=first=%d second=%d third=%d})

-- Val "first=10 second=11 third=12"

--

-- >>> pl @(PrintL 2 "first=%d second=%d third=%d" Id) [10,11,12]

-- Error toITupleListC: expected exactly 2 values (ToITupleList(2) instead found 3)

-- Fail "toITupleListC: expected exactly 2 values"

--

-- >>> pl @(PrintL 4 "first=%d second=%d third=%d" Id) [10,11,12]

-- Error toITupleListC: expected exactly 4 values (ToITupleList(4) instead found 3)

-- Fail "toITupleListC: expected exactly 4 values"

--

-- >>> pl @(PrintL 4 "%03d.%03d.%03d.%03d" Id) [1,2,3,4]

-- Present "001.002.003.004" ((>>) "001.002.003.004" | {PrintI [001.002.003.004] | s=%03d.%03d.%03d.%03d})

-- Val "001.002.003.004"

--

-- >>> pl @(PrintL 4 "%03d.%03d.%03d.%03d" Id) [1,2,3,4,5]

-- Error toITupleListC: expected exactly 4 values (ToITupleList(4) instead found 5)

-- Fail "toITupleListC: expected exactly 4 values"

--

-- >>> pl @(PrintL 4 "%03d.%03d.%03d.%03d" Id) [1,2,3]

-- Error toITupleListC: expected exactly 4 values (ToITupleList(4) instead found 3)

-- Fail "toITupleListC: expected exactly 4 values"

--

-- >>> pl @(PrintL 4 "%03d.%03d.%03d.%03d" Id) [1,2,3,4]

-- Present "001.002.003.004" ((>>) "001.002.003.004" | {PrintI [001.002.003.004] | s=%03d.%03d.%03d.%03d})

-- Val "001.002.003.004"

--

-- >>> pl @(PrintL 4 "%d %4d %-d %03d" Id) [1..4]

-- Present "1    2 3 004" ((>>) "1    2 3 004" | {PrintI [1    2 3 004] | s=%d %4d %-d %03d})

-- Val "1    2 3 004"

--

data PrintL (n :: Nat) s p deriving Int -> PrintL n s p -> ShowS
[PrintL n s p] -> ShowS
PrintL n s p -> String
(Int -> PrintL n s p -> ShowS)
-> (PrintL n s p -> String)
-> ([PrintL n s p] -> ShowS)
-> Show (PrintL n s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat) k (s :: k) k (p :: k).
Int -> PrintL n s p -> ShowS
forall (n :: Nat) k (s :: k) k (p :: k). [PrintL n s p] -> ShowS
forall (n :: Nat) k (s :: k) k (p :: k). PrintL n s p -> String
showList :: [PrintL n s p] -> ShowS
$cshowList :: forall (n :: Nat) k (s :: k) k (p :: k). [PrintL n s p] -> ShowS
show :: PrintL n s p -> String
$cshow :: forall (n :: Nat) k (s :: k) k (p :: k). PrintL n s p -> String
showsPrec :: Int -> PrintL n s p -> ShowS
$cshowsPrec :: forall (n :: Nat) k (s :: k) k (p :: k).
Int -> PrintL n s p -> ShowS
Show
type PrintLT (n :: Nat) s p = p >> ToITupleList n >> ReverseITuple >> PrintI s

instance P (PrintLT n s p) x => P (PrintL n s p) x where
  type PP (PrintL n s p) x = PP (PrintLT n s p) x
  eval :: proxy (PrintL n s p) -> POpts -> x -> m (TT (PP (PrintL n s p) x))
eval proxy (PrintL n s p)
_ = Proxy (PrintLT n s p)
-> POpts -> x -> m (TT (PP (PrintLT n s p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (PrintLT n s p)
forall k (t :: k). Proxy t
Proxy @(PrintLT n s p))