-- | Parse format strings provided by --format, with awareness of
-- hledger's report item fields. The formats are used by
-- report-specific renderers like renderBalanceReportItem.

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports    #-}
{-# LANGUAGE TypeFamilies      #-}

module Hledger.Data.StringFormat (
          parseStringFormat
        , defaultStringFormatStyle
        , StringFormat(..)
        , StringFormatComponent(..)
        , ReportItemField(..)
        , defaultBalanceLineFormat
        , tests_StringFormat
        ) where

import Prelude ()
import "base-compat-batteries" Prelude.Compat
import Numeric (readDec)
import Data.Char (isPrint)
import Data.Default (Default(..))
import Data.Maybe (isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Megaparsec
import Text.Megaparsec.Char (char, digitChar, string)

import Hledger.Utils.Parse (SimpleTextParser)
import Hledger.Utils.Text (formatText)
import Hledger.Utils.Test

-- | A format specification/template to use when rendering a report line item as text.
--
-- A format is a sequence of components; each is either a literal
-- string, or a hledger report item field with specified width and
-- justification whose value will be interpolated at render time.
--
-- A component's value may be a multi-line string (or a
-- multi-commodity amount), in which case the final string will be
-- either single-line or a top or bottom-aligned multi-line string
-- depending on the StringFormat variant used.
--
-- Currently this is only used in the balance command's single-column
-- mode, which provides a limited StringFormat renderer.
--
data StringFormat =
    OneLine       [StringFormatComponent] -- ^ multi-line values will be rendered on one line, comma-separated
  | TopAligned    [StringFormatComponent] -- ^ values will be top-aligned (and bottom-padded to the same height)
  | BottomAligned [StringFormatComponent] -- ^ values will be bottom-aligned (and top-padded)
  deriving (Int -> StringFormat -> ShowS
[StringFormat] -> ShowS
StringFormat -> String
(Int -> StringFormat -> ShowS)
-> (StringFormat -> String)
-> ([StringFormat] -> ShowS)
-> Show StringFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringFormat] -> ShowS
$cshowList :: [StringFormat] -> ShowS
show :: StringFormat -> String
$cshow :: StringFormat -> String
showsPrec :: Int -> StringFormat -> ShowS
$cshowsPrec :: Int -> StringFormat -> ShowS
Show, StringFormat -> StringFormat -> Bool
(StringFormat -> StringFormat -> Bool)
-> (StringFormat -> StringFormat -> Bool) -> Eq StringFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringFormat -> StringFormat -> Bool
$c/= :: StringFormat -> StringFormat -> Bool
== :: StringFormat -> StringFormat -> Bool
$c== :: StringFormat -> StringFormat -> Bool
Eq)

data StringFormatComponent =
    FormatLiteral Text          -- ^ Literal text to be rendered as-is
  | FormatField Bool
                (Maybe Int)
                (Maybe Int)
                ReportItemField -- ^ A data field to be formatted and interpolated. Parameters:
                                --
                                -- - Left justify ? Right justified if false
                                -- - Minimum width ? Will be space-padded if narrower than this
                                -- - Maximum width ? Will be clipped if wider than this
                                -- - Which of the standard hledger report item fields to interpolate
  deriving (Int -> StringFormatComponent -> ShowS
[StringFormatComponent] -> ShowS
StringFormatComponent -> String
(Int -> StringFormatComponent -> ShowS)
-> (StringFormatComponent -> String)
-> ([StringFormatComponent] -> ShowS)
-> Show StringFormatComponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringFormatComponent] -> ShowS
$cshowList :: [StringFormatComponent] -> ShowS
show :: StringFormatComponent -> String
$cshow :: StringFormatComponent -> String
showsPrec :: Int -> StringFormatComponent -> ShowS
$cshowsPrec :: Int -> StringFormatComponent -> ShowS
Show, StringFormatComponent -> StringFormatComponent -> Bool
(StringFormatComponent -> StringFormatComponent -> Bool)
-> (StringFormatComponent -> StringFormatComponent -> Bool)
-> Eq StringFormatComponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringFormatComponent -> StringFormatComponent -> Bool
$c/= :: StringFormatComponent -> StringFormatComponent -> Bool
== :: StringFormatComponent -> StringFormatComponent -> Bool
$c== :: StringFormatComponent -> StringFormatComponent -> Bool
Eq)

-- | An id identifying which report item field to interpolate.  These
-- are drawn from several hledger report types, so are not all
-- applicable for a given report.
data ReportItemField =
    AccountField      -- ^ A posting or balance report item's account name
  | DefaultDateField  -- ^ A posting or register or entry report item's date
  | DescriptionField  -- ^ A posting or register or entry report item's description
  | TotalField        -- ^ A balance or posting report item's balance or running total.
                      --   Always rendered right-justified.
  | DepthSpacerField  -- ^ A balance report item's indent level (which may be different from the account name depth).
                      --   Rendered as this number of spaces, multiplied by the minimum width spec if any.
  | FieldNo Int       -- ^ A report item's nth field. May be unimplemented.
    deriving (Int -> ReportItemField -> ShowS
[ReportItemField] -> ShowS
ReportItemField -> String
(Int -> ReportItemField -> ShowS)
-> (ReportItemField -> String)
-> ([ReportItemField] -> ShowS)
-> Show ReportItemField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportItemField] -> ShowS
$cshowList :: [ReportItemField] -> ShowS
show :: ReportItemField -> String
$cshow :: ReportItemField -> String
showsPrec :: Int -> ReportItemField -> ShowS
$cshowsPrec :: Int -> ReportItemField -> ShowS
Show, ReportItemField -> ReportItemField -> Bool
(ReportItemField -> ReportItemField -> Bool)
-> (ReportItemField -> ReportItemField -> Bool)
-> Eq ReportItemField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportItemField -> ReportItemField -> Bool
$c/= :: ReportItemField -> ReportItemField -> Bool
== :: ReportItemField -> ReportItemField -> Bool
$c== :: ReportItemField -> ReportItemField -> Bool
Eq)

instance Default StringFormat where def :: StringFormat
def = StringFormat
defaultBalanceLineFormat

-- | Default line format for balance report: "%20(total)  %2(depth_spacer)%-(account)"
defaultBalanceLineFormat :: StringFormat
defaultBalanceLineFormat :: StringFormat
defaultBalanceLineFormat = [StringFormatComponent] -> StringFormat
BottomAligned [
      Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) Maybe Int
forall a. Maybe a
Nothing ReportItemField
TotalField
    , Text -> StringFormatComponent
FormatLiteral Text
"  "
    , Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
True (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Maybe Int
forall a. Maybe a
Nothing ReportItemField
DepthSpacerField
    , Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
True Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing ReportItemField
AccountField
    ]
----------------------------------------------------------------------

-- renderStringFormat :: StringFormat -> Map String String -> String
-- renderStringFormat fmt params =

----------------------------------------------------------------------

-- | Parse a string format specification, or return a parse error.
parseStringFormat :: Text -> Either String StringFormat
parseStringFormat :: Text -> Either String StringFormat
parseStringFormat Text
input = case (Parsec CustomErr Text StringFormat
-> String
-> Text
-> Either (ParseErrorBundle Text CustomErr) StringFormat
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (Parsec CustomErr Text StringFormat
stringformatp Parsec CustomErr Text StringFormat
-> ParsecT CustomErr Text Identity ()
-> Parsec CustomErr Text StringFormat
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomErr Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"(unknown)") Text
input of
    Left ParseErrorBundle Text CustomErr
y -> String -> Either String StringFormat
forall a b. a -> Either a b
Left (String -> Either String StringFormat)
-> String -> Either String StringFormat
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> String
forall a. Show a => a -> String
show ParseErrorBundle Text CustomErr
y
    Right StringFormat
x -> StringFormat -> Either String StringFormat
forall a b. b -> Either a b
Right StringFormat
x

defaultStringFormatStyle :: [StringFormatComponent] -> StringFormat
defaultStringFormatStyle = [StringFormatComponent] -> StringFormat
BottomAligned

stringformatp :: SimpleTextParser StringFormat
stringformatp :: Parsec CustomErr Text StringFormat
stringformatp = do
  Maybe Char
alignspec <- ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomErr Text Identity Char
 -> ParsecT CustomErr Text Identity Char)
-> ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity Char
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT CustomErr Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'%' ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Token Text] -> ParsecT CustomErr Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf (String
"^_,"::String))
  let constructor :: [StringFormatComponent] -> StringFormat
constructor =
        case Maybe Char
alignspec of
          Just Char
'^' -> [StringFormatComponent] -> StringFormat
TopAligned
          Just Char
'_' -> [StringFormatComponent] -> StringFormat
BottomAligned
          Just Char
',' -> [StringFormatComponent] -> StringFormat
OneLine
          Maybe Char
_        -> [StringFormatComponent] -> StringFormat
defaultStringFormatStyle
  [StringFormatComponent] -> StringFormat
constructor ([StringFormatComponent] -> StringFormat)
-> ParsecT CustomErr Text Identity [StringFormatComponent]
-> Parsec CustomErr Text StringFormat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text Identity StringFormatComponent
-> ParsecT CustomErr Text Identity [StringFormatComponent]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT CustomErr Text Identity StringFormatComponent
componentp

componentp :: SimpleTextParser StringFormatComponent
componentp :: ParsecT CustomErr Text Identity StringFormatComponent
componentp = ParsecT CustomErr Text Identity StringFormatComponent
formatliteralp ParsecT CustomErr Text Identity StringFormatComponent
-> ParsecT CustomErr Text Identity StringFormatComponent
-> ParsecT CustomErr Text Identity StringFormatComponent
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomErr Text Identity StringFormatComponent
formatfieldp

formatliteralp :: SimpleTextParser StringFormatComponent
formatliteralp :: ParsecT CustomErr Text Identity StringFormatComponent
formatliteralp = do
    Text
s <- String -> Text
T.pack (String -> Text)
-> ParsecT CustomErr Text Identity String
-> ParsecT CustomErr Text Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text Identity Char
c
    StringFormatComponent
-> ParsecT CustomErr Text Identity StringFormatComponent
forall (m :: * -> *) a. Monad m => a -> m a
return (StringFormatComponent
 -> ParsecT CustomErr Text Identity StringFormatComponent)
-> StringFormatComponent
-> ParsecT CustomErr Text Identity StringFormatComponent
forall a b. (a -> b) -> a -> b
$ Text -> StringFormatComponent
FormatLiteral Text
s
    where
      isPrintableButNotPercentage :: Char -> Bool
isPrintableButNotPercentage Char
x = Char -> Bool
isPrint Char
x Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'%'
      c :: ParsecT CustomErr Text Identity Char
c =     ((Token Text -> Bool)
-> ParsecT CustomErr Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
Token Text -> Bool
isPrintableButNotPercentage ParsecT CustomErr Text Identity Char
-> String -> ParsecT CustomErr Text Identity Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"printable character")
          ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT CustomErr Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"%%" ParsecT CustomErr Text Identity (Tokens Text)
-> ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT CustomErr Text Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
'%')

formatfieldp :: SimpleTextParser StringFormatComponent
formatfieldp :: ParsecT CustomErr Text Identity StringFormatComponent
formatfieldp = do
    Token Text -> ParsecT CustomErr Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'%'
    Maybe Char
leftJustified <- ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT CustomErr Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-')
    Maybe String
minWidth <- ParsecT CustomErr Text Identity String
-> ParsecT CustomErr Text Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT CustomErr Text Identity Char
 -> ParsecT CustomErr Text Identity String)
-> ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
    Maybe String
maxWidth <- ParsecT CustomErr Text Identity String
-> ParsecT CustomErr Text Identity (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do Token Text -> ParsecT CustomErr Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'.'; ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT CustomErr Text Identity Char
 -> ParsecT CustomErr Text Identity String)
-> ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity String
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar) -- TODO: Can this be (char '1') *> (some digitChar)
    Token Text -> ParsecT CustomErr Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'('
    ReportItemField
f <- SimpleTextParser ReportItemField
fieldp
    Token Text -> ParsecT CustomErr Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')'
    StringFormatComponent
-> ParsecT CustomErr Text Identity StringFormatComponent
forall (m :: * -> *) a. Monad m => a -> m a
return (StringFormatComponent
 -> ParsecT CustomErr Text Identity StringFormatComponent)
-> StringFormatComponent
-> ParsecT CustomErr Text Identity StringFormatComponent
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField (Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
leftJustified) (Maybe String -> Maybe Int
forall a. (Eq a, Num a) => Maybe String -> Maybe a
parseDec Maybe String
minWidth) (Maybe String -> Maybe Int
forall a. (Eq a, Num a) => Maybe String -> Maybe a
parseDec Maybe String
maxWidth) ReportItemField
f
    where
      parseDec :: Maybe String -> Maybe a
parseDec Maybe String
s = case Maybe String
s of
        Just String
text -> a -> Maybe a
forall a. a -> Maybe a
Just a
m where ((a
m,String
_):[(a, String)]
_) = ReadS a
forall a. (Eq a, Num a) => ReadS a
readDec String
text
        Maybe String
_ -> Maybe a
forall a. Maybe a
Nothing

fieldp :: SimpleTextParser ReportItemField
fieldp :: SimpleTextParser ReportItemField
fieldp = do
        SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT CustomErr Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"account" ParsecT CustomErr Text Identity Text
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReportItemField -> SimpleTextParser ReportItemField
forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
AccountField)
    SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT CustomErr Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"depth_spacer" ParsecT CustomErr Text Identity Text
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReportItemField -> SimpleTextParser ReportItemField
forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
DepthSpacerField)
    SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT CustomErr Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"date" ParsecT CustomErr Text Identity Text
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReportItemField -> SimpleTextParser ReportItemField
forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
DescriptionField)
    SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT CustomErr Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"description" ParsecT CustomErr Text Identity Text
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReportItemField -> SimpleTextParser ReportItemField
forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
DescriptionField)
    SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Tokens Text -> ParsecT CustomErr Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"total" ParsecT CustomErr Text Identity Text
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReportItemField -> SimpleTextParser ReportItemField
forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
TotalField)
    SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser ReportItemField
-> SimpleTextParser ReportItemField
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((Int -> ReportItemField
FieldNo (Int -> ReportItemField)
-> (String -> Int) -> String -> ReportItemField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read) (String -> ReportItemField)
-> ParsecT CustomErr Text Identity String
-> SimpleTextParser ReportItemField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomErr Text Identity Char
-> ParsecT CustomErr Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT CustomErr Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)

----------------------------------------------------------------------

formatStringTester :: StringFormatComponent -> Text -> Text -> Assertion
formatStringTester StringFormatComponent
fs Text
value Text
expected = Text
actual Text -> Text -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Text
expected
  where
    actual :: Text
actual = case StringFormatComponent
fs of
      FormatLiteral Text
l                   -> Bool -> Maybe Int -> Maybe Int -> Text -> Text
formatText Bool
False Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Text
l
      FormatField Bool
leftJustify Maybe Int
min Maybe Int
max ReportItemField
_ -> Bool -> Maybe Int -> Maybe Int -> Text -> Text
formatText Bool
leftJustify Maybe Int
min Maybe Int
max Text
value

tests_StringFormat :: TestTree
tests_StringFormat = String -> [TestTree] -> TestTree
tests String
"StringFormat" [

   String -> Assertion -> TestTree
test String
"formatStringHelper" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
      StringFormatComponent -> Text -> Text -> Assertion
formatStringTester (Text -> StringFormatComponent
FormatLiteral Text
" ")                                     Text
""            Text
" "
      StringFormatComponent -> Text -> Text -> Assertion
formatStringTester (Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing ReportItemField
DescriptionField)    Text
"description" Text
"description"
      StringFormatComponent -> Text -> Text -> Assertion
formatStringTester (Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) Maybe Int
forall a. Maybe a
Nothing ReportItemField
DescriptionField)  Text
"description" Text
"         description"
      StringFormatComponent -> Text -> Text -> Assertion
formatStringTester (Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) ReportItemField
DescriptionField)  Text
"description" Text
"description"
      StringFormatComponent -> Text -> Text -> Assertion
formatStringTester (Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
True Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) ReportItemField
DescriptionField)   Text
"description" Text
"description"
      StringFormatComponent -> Text -> Text -> Assertion
formatStringTester (Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
True (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) Maybe Int
forall a. Maybe a
Nothing ReportItemField
DescriptionField)   Text
"description" Text
"description         "
      StringFormatComponent -> Text -> Text -> Assertion
formatStringTester (Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
True (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) ReportItemField
DescriptionField) Text
"description" Text
"description         "
      StringFormatComponent -> Text -> Text -> Assertion
formatStringTester (Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
True Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) ReportItemField
DescriptionField)    Text
"description" Text
"des"

  ,let String
s gives :: String -> StringFormat -> TestTree
`gives` StringFormat
expected = String -> Assertion -> TestTree
test String
s (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Text -> Either String StringFormat
parseStringFormat (String -> Text
T.pack String
s) Either String StringFormat
-> Either String StringFormat -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= StringFormat -> Either String StringFormat
forall a b. b -> Either a b
Right StringFormat
expected
   in String -> [TestTree] -> TestTree
tests String
"parseStringFormat" [
      String
""                           String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [])
    , String
"D"                          String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [Text -> StringFormatComponent
FormatLiteral Text
"D"])
    , String
"%(date)"                    String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing ReportItemField
DescriptionField])
    , String
"%(total)"                   String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing ReportItemField
TotalField])
    -- TODO
    -- , "^%(total)"                  `gives` (TopAligned [FormatField False Nothing Nothing TotalField])
    -- , "_%(total)"                  `gives` (BottomAligned [FormatField False Nothing Nothing TotalField])
    -- , ",%(total)"                  `gives` (OneLine [FormatField False Nothing Nothing TotalField])
    , String
"Hello %(date)!"             String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [Text -> StringFormatComponent
FormatLiteral Text
"Hello ", Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing ReportItemField
DescriptionField, Text -> StringFormatComponent
FormatLiteral Text
"!"])
    , String
"%-(date)"                   String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
True Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing ReportItemField
DescriptionField])
    , String
"%20(date)"                  String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) Maybe Int
forall a. Maybe a
Nothing ReportItemField
DescriptionField])
    , String
"%.10(date)"                 String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10) ReportItemField
DescriptionField])
    , String
"%20.10(date)"               String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10) ReportItemField
DescriptionField])
    , String
"%20(account) %.10(total)"   String -> StringFormat -> TestTree
`gives` ([StringFormatComponent] -> StringFormat
defaultStringFormatStyle [Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20) Maybe Int
forall a. Maybe a
Nothing ReportItemField
AccountField
                                                                     ,Text -> StringFormatComponent
FormatLiteral Text
" "
                                                                     ,Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10) ReportItemField
TotalField
                                                                     ])
    , String -> Assertion -> TestTree
test String
"newline not parsed" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Either String StringFormat -> Assertion
forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft (Either String StringFormat -> Assertion)
-> Either String StringFormat -> Assertion
forall a b. (a -> b) -> a -> b
$ Text -> Either String StringFormat
parseStringFormat Text
"\n"
    ]
 ]