{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Hledger.Data.StringFormat (
parseStringFormat
, defaultStringFormatStyle
, StringFormat(..)
, StringFormatComponent(..)
, ReportItemField(..)
, defaultBalanceLineFormat
, tests_StringFormat
) where
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
data StringFormat =
OneLine [StringFormatComponent]
| TopAligned [StringFormatComponent]
| BottomAligned [StringFormatComponent]
deriving (Int -> StringFormat -> ShowS
[StringFormat] -> ShowS
StringFormat -> String
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
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
| FormatField Bool
(Maybe Int)
(Maybe Int)
ReportItemField
deriving (Int -> StringFormatComponent -> ShowS
[StringFormatComponent] -> ShowS
StringFormatComponent -> String
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
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)
data ReportItemField =
AccountField
| DefaultDateField
| DescriptionField
| TotalField
| DepthSpacerField
| FieldNo Int
deriving (Int -> ReportItemField -> ShowS
[ReportItemField] -> ShowS
ReportItemField -> String
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
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
defaultBalanceLineFormat :: StringFormat
defaultBalanceLineFormat :: StringFormat
defaultBalanceLineFormat = [StringFormatComponent] -> StringFormat
BottomAligned [
Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False (forall a. a -> Maybe a
Just Int
20) forall a. Maybe a
Nothing ReportItemField
TotalField
, Text -> StringFormatComponent
FormatLiteral Text
" "
, Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
True (forall a. a -> Maybe a
Just Int
2) forall a. Maybe a
Nothing ReportItemField
DepthSpacerField
, Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
True forall a. Maybe a
Nothing forall a. Maybe a
Nothing ReportItemField
AccountField
]
parseStringFormat :: Text -> Either String StringFormat
parseStringFormat :: Text -> Either String StringFormat
parseStringFormat Text
input = case (forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser (ParsecT HledgerParseErrorData Text Identity StringFormat
stringformatp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) String
"(unknown)") Text
input of
Left ParseErrorBundle Text HledgerParseErrorData
y -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseErrorBundle Text HledgerParseErrorData
y
Right StringFormat
x -> forall a b. b -> Either a b
Right StringFormat
x
defaultStringFormatStyle :: [StringFormatComponent] -> StringFormat
defaultStringFormatStyle = [StringFormatComponent] -> StringFormat
BottomAligned
stringformatp :: SimpleTextParser StringFormat
stringformatp :: ParsecT HledgerParseErrorData Text Identity StringFormat
stringformatp = do
Maybe Char
alignspec <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'%' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many SimpleTextParser StringFormatComponent
componentp
componentp :: SimpleTextParser StringFormatComponent
componentp :: SimpleTextParser StringFormatComponent
componentp = SimpleTextParser StringFormatComponent
formatliteralp forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SimpleTextParser StringFormatComponent
formatfieldp
formatliteralp :: SimpleTextParser StringFormatComponent
formatliteralp :: SimpleTextParser StringFormatComponent
formatliteralp = do
Text
s <- String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT HledgerParseErrorData Text Identity Char
c
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Eq a => a -> a -> Bool
/= Char
'%'
c :: ParsecT HledgerParseErrorData Text Identity Char
c = (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isPrintableButNotPercentage forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"printable character")
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"%%" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char
'%')
formatfieldp :: SimpleTextParser StringFormatComponent
formatfieldp :: SimpleTextParser StringFormatComponent
formatfieldp = do
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'%'
Maybe (Token Text)
leftJustified <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-')
Maybe String
minWidth <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
Maybe String
maxWidth <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (do forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'.'; forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'('
ReportItemField
f <- SimpleTextParser ReportItemField
fieldp
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField (forall a. Maybe a -> Bool
isJust Maybe (Token Text)
leftJustified) (forall {a}. (Eq a, Num a) => Maybe String -> Maybe a
parseDec Maybe String
minWidth forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just Int
0) (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 -> forall a. a -> Maybe a
Just a
m where ((a
m,String
_):[(a, String)]
_) = forall a. (Eq a, Num a) => ReadS a
readDec String
text
Maybe String
_ -> forall a. Maybe a
Nothing
fieldp :: SimpleTextParser ReportItemField
fieldp :: SimpleTextParser ReportItemField
fieldp = do
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"account" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
AccountField)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"depth_spacer" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
DepthSpacerField)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"date" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
DescriptionField)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"description" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
DescriptionField)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"total" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ReportItemField
TotalField)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ((Int -> ReportItemField
FieldNo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some 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 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing Text
l
FormatField Bool
leftJustify Maybe Int
mn Maybe Int
mx ReportItemField
_ -> Bool -> Maybe Int -> Maybe Int -> Text -> Text
formatText Bool
leftJustify Maybe Int
mn Maybe Int
mx Text
value
tests_StringFormat :: TestTree
tests_StringFormat = String -> [TestTree] -> TestTree
testGroup String
"StringFormat" [
String -> Assertion -> TestTree
testCase String
"formatStringHelper" 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 forall a. Maybe a
Nothing 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 (forall a. a -> Maybe a
Just Int
20) 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 forall a. Maybe a
Nothing (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 forall a. Maybe a
Nothing (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 (forall a. a -> Maybe a
Just Int
20) 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 (forall a. a -> Maybe a
Just Int
20) (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 forall a. Maybe a
Nothing (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
testCase String
s forall a b. (a -> b) -> a -> b
$ Text -> Either String StringFormat
parseStringFormat (String -> Text
T.pack String
s) forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a b. b -> Either a b
Right StringFormat
expected
in String -> [TestTree] -> TestTree
testGroup 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 (forall a. a -> Maybe a
Just Int
0) 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 (forall a. a -> Maybe a
Just Int
0) forall a. Maybe a
Nothing ReportItemField
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 (forall a. a -> Maybe a
Just Int
0) 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 (forall a. a -> Maybe a
Just Int
0) 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 (forall a. a -> Maybe a
Just Int
20) 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 (forall a. a -> Maybe a
Just Int
0) (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 (forall a. a -> Maybe a
Just Int
20) (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 (forall a. a -> Maybe a
Just Int
20) forall a. Maybe a
Nothing ReportItemField
AccountField
,Text -> StringFormatComponent
FormatLiteral Text
" "
,Bool
-> Maybe Int
-> Maybe Int
-> ReportItemField
-> StringFormatComponent
FormatField Bool
False (forall a. a -> Maybe a
Just Int
0) (forall a. a -> Maybe a
Just Int
10) ReportItemField
TotalField
])
, String -> Assertion -> TestTree
testCase String
"newline not parsed" forall a b. (a -> b) -> a -> b
$ forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft forall a b. (a -> b) -> a -> b
$ Text -> Either String StringFormat
parseStringFormat Text
"\n"
]
]