{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Web.Widget.AddForm
( addForm
, addModal
) where
import Control.Monad.State.Strict (evalStateT)
import Data.Bifunctor (first)
import Data.Foldable (toList)
import Data.List (dropWhileEnd, unfoldr)
import Data.Maybe (isJust, fromMaybe)
import qualified Data.Set as S
import Data.Text (Text)
import Data.Text.Encoding.Base64 (encodeBase64)
import qualified Data.Text as T
import Data.Time (Day)
import Text.Blaze.Internal (Markup, preEscapedText)
import Text.Megaparsec (bundleErrors, eof, parseErrorTextPretty, runParser)
import Yesod
import Hledger
import Hledger.Web.Foundation (App, Handler, Widget)
import Hledger.Web.Settings (widgetFile)
import Data.Function ((&))
import Control.Arrow (right)
addModal :: Route App -> Journal -> Day -> Widget
addModal :: Route App -> Journal -> Day -> WidgetFor App ()
addModal Route App
addR Journal
j Day
today = do
(WidgetFor App ()
addView, Enctype
addEnctype) <- forall site a. HandlerFor site a -> WidgetFor site a
handlerToWidget forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a xml.
(RenderMessage (HandlerSite m) FormMessage, MonadHandler m) =>
(Markup -> MForm m (FormResult a, xml)) -> m (xml, Enctype)
generateFormPost (Journal
-> Day
-> Markup
-> MForm
(HandlerFor App)
(FormResult (Transaction, FilePath), WidgetFor App ())
addForm Journal
j Day
today)
[whamlet|
<div .modal #addmodal tabindex="-1" role="dialog" aria-labelledby="addLabel" aria-hidden="true">
<div .modal-dialog .modal-lg>
<div .modal-content>
<div .modal-header>
<button type="button" .close data-dismiss="modal" aria-hidden="true">×
<h3 .modal-title #addLabel>Add a transaction
<div .modal-body>
<form#addform.form action=@{addR} method=POST enctype=#{addEnctype}>
^{addView}
|]
addForm :: Journal -> Day -> Markup -> MForm Handler (FormResult (Transaction,FilePath), Widget)
addForm :: Journal
-> Day
-> Markup
-> MForm
(HandlerFor App)
(FormResult (Transaction, FilePath), WidgetFor App ())
addForm Journal
j Day
today = forall (m :: * -> *) a.
Monad m =>
Text
-> (Markup -> MForm m (FormResult a, WidgetFor (HandlerSite m) ()))
-> Markup
-> MForm m (FormResult a, WidgetFor (HandlerSite m) ())
identifyForm Text
"add" forall a b. (a -> b) -> a -> b
$ \Markup
extra -> do
let
descriptions :: Set Text
descriptions = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. Ord a => [a] -> Set a
S.fromList [Journal -> [Text]
journalPayeesDeclaredOrUsed Journal
j, Journal -> [Text]
journalDescriptions Journal
j]
files :: [FilePath]
files = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> [(FilePath, Text)]
jfiles Journal
j
deffile :: FilePath
deffile = Journal -> FilePath
journalFilePath Journal
j
(FormResult Day
dateRes, FieldView (HandlerSite (HandlerFor App))
dateView) <- forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreq Field (HandlerFor App) Day
dateField forall {master}. FieldSettings master
dateSettings forall a. Maybe a
Nothing
(FormResult (Maybe Text)
descRes, FieldView (HandlerSite (HandlerFor App))
descView) <- forall site (m :: * -> *) a.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> MForm m (FormResult (Maybe a), FieldView site)
mopt forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField forall {master}. FieldSettings master
descSettings forall a. Maybe a
Nothing
(FormResult [Text]
acctsRes, FieldView (HandlerSite (HandlerFor App))
_) <- forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreq Field (HandlerFor App) [Text]
listField forall {master}. FieldSettings master
acctSettings forall a. Maybe a
Nothing
(FormResult [Text]
amtsRes, FieldView App
_) <- forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe a
-> MForm m (FormResult a, FieldView site)
mreq Field (HandlerFor App) [Text]
listField forall {master}. FieldSettings master
amtSettings forall a. Maybe a
Nothing
(FormResult (Maybe FilePath)
fileRes, FieldView App
fileView) <- forall site (m :: * -> *) a.
(site ~ HandlerSite m, MonadHandler m) =>
Field m a
-> FieldSettings site
-> Maybe (Maybe a)
-> MForm m (FormResult (Maybe a), FieldView site)
mopt Field (HandlerFor App) FilePath
fileField' forall {master}. FieldSettings master
fileSettings forall a. Maybe a
Nothing
let
(FormResult [Posting]
postingsRes, [(Int, (Text, Text, Maybe Text, Maybe Text))]
displayRows) = FormResult [Text]
-> FormResult [Text]
-> (FormResult [Posting],
[(Int, (Text, Text, Maybe Text, Maybe Text))])
validatePostings FormResult [Text]
acctsRes FormResult [Text]
amtsRes
formRes :: FormResult (Transaction, FilePath)
formRes = FilePath
-> FormResult Day
-> FormResult (Maybe Text)
-> FormResult [Posting]
-> FormResult (Maybe FilePath)
-> FormResult (Transaction, FilePath)
validateTransaction FilePath
deffile FormResult Day
dateRes FormResult (Maybe Text)
descRes FormResult [Posting]
postingsRes FormResult (Maybe FilePath)
fileRes
forall (m :: * -> *) a. Monad m => a -> m a
return (FormResult (Transaction, FilePath)
formRes, $(widgetFile "add-form"))
where
dateField :: Field (HandlerFor App) Day
dateField = forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) msg a b.
(Monad m, RenderMessage (HandlerSite m) msg) =>
(a -> m (Either msg b)) -> (b -> a) -> Field m a -> Field m b
checkMMap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right EFDay -> Day
fromEFDay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text EFDay
validateDate) (FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show)
where
validateDate :: Text -> Either Text EFDay
validateDate Text
s =
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. a -> b -> a
const (Text
"Invalid date format" :: Text)) forall a b. (a -> b) -> a -> b
$
Day -> Text -> Either HledgerParseErrors EFDay
fixSmartDateStrEither' Day
today (Text -> Text
T.strip Text
s)
listField :: Field (HandlerFor App) [Text]
listField = Field
{ fieldParse :: [Text]
-> [FileInfo]
-> Handler
(Either
(SomeMessage (HandlerSite (HandlerFor App))) (Maybe [Text]))
fieldParse = forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Text -> Bool
T.null
, fieldView :: FieldViewFunc (HandlerFor App) [Text]
fieldView = forall a. FilePath -> a
error' FilePath
"listField should not be used for rendering"
, fieldEnctype :: Enctype
fieldEnctype = Enctype
UrlEncoded
}
fileField' :: Field Handler FilePath
fileField' :: Field (HandlerFor App) FilePath
fileField' = forall a site msg.
(Eq a, RenderMessage site FormMessage, RenderMessage site msg) =>
[(msg, a)] -> Field (HandlerFor site) a
selectFieldList [(FilePath -> Text
T.pack FilePath
f, FilePath
f) | FilePath
f <- [FilePath]
fs] forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) msg a.
(Monad m, RenderMessage (HandlerSite m) msg) =>
(a -> Either msg a) -> Field m a -> Field m a
check FilePath -> Either FormMessage FilePath
validateFilepath
where
fs :: [FilePath]
fs = Journal -> [FilePath]
journalFilePaths Journal
j
validateFilepath :: FilePath -> Either FormMessage FilePath
validateFilepath :: FilePath -> Either FormMessage FilePath
validateFilepath FilePath
f
| FilePath
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
fs = forall a b. b -> Either a b
Right FilePath
f
| Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> FormMessage
MsgInputNotFound forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
f
dateSettings :: FieldSettings master
dateSettings = forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings SomeMessage master
"date" forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
"date") [(Text
"class", Text
"form-control input-lg"), (Text
"placeholder", Text
"Date")]
descSettings :: FieldSettings master
descSettings = forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings SomeMessage master
"desc" forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
"description") [(Text
"class", Text
"form-control input-lg typeahead"), (Text
"placeholder", Text
"Description"), (Text
"size", Text
"40")]
acctSettings :: FieldSettings master
acctSettings = forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings SomeMessage master
"account" forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
"account") []
amtSettings :: FieldSettings master
amtSettings = forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings SomeMessage master
"amount" forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
"amount") []
fileSettings :: FieldSettings master
fileSettings = forall master.
SomeMessage master
-> Maybe (SomeMessage master)
-> Maybe Text
-> Maybe Text
-> [(Text, Text)]
-> FieldSettings master
FieldSettings SomeMessage master
"file" forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
"file") [(Text
"class", Text
"form-control input-lg")]
validateTransaction ::
FilePath -> FormResult Day -> FormResult (Maybe Text) -> FormResult [Posting] -> FormResult (Maybe FilePath)
-> FormResult (Transaction, FilePath)
validateTransaction :: FilePath
-> FormResult Day
-> FormResult (Maybe Text)
-> FormResult [Posting]
-> FormResult (Maybe FilePath)
-> FormResult (Transaction, FilePath)
validateTransaction FilePath
deffile FormResult Day
dateRes FormResult (Maybe Text)
descRes FormResult [Posting]
postingsRes FormResult (Maybe FilePath)
fileRes =
case Day
-> Maybe Text
-> [Posting]
-> Maybe FilePath
-> (Transaction, FilePath)
makeTransaction forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FormResult Day
dateRes forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormResult (Maybe Text)
descRes forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormResult [Posting]
postingsRes forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FormResult (Maybe FilePath)
fileRes of
FormSuccess (Transaction
txn,FilePath
f) -> case BalancingOpts -> Transaction -> Either FilePath Transaction
balanceTransaction BalancingOpts
defbalancingopts Transaction
txn of
Left FilePath
e -> forall a. [Text] -> FormResult a
FormFailure [FilePath -> Text
T.pack FilePath
e]
Right Transaction
txn' -> forall a. a -> FormResult a
FormSuccess (Transaction
txn',FilePath
f)
FormResult (Transaction, FilePath)
x -> FormResult (Transaction, FilePath)
x
where
makeTransaction :: Day
-> Maybe Text
-> [Posting]
-> Maybe FilePath
-> (Transaction, FilePath)
makeTransaction Day
date Maybe Text
mdesc [Posting]
postings Maybe FilePath
mfile =
(Transaction
nulltransaction {
tdate :: Day
tdate = Day
date
,tdescription :: Text
tdescription = forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mdesc
,tpostings :: [Posting]
tpostings = [Posting]
postings
,tsourcepos :: (SourcePos, SourcePos)
tsourcepos = (FilePath -> SourcePos
initialPos FilePath
f, FilePath -> SourcePos
initialPos FilePath
f)
}, FilePath
f)
where f :: FilePath
f = forall a. a -> Maybe a -> a
fromMaybe FilePath
deffile Maybe FilePath
mfile
validatePostings ::
FormResult [Text] -> FormResult [Text]
-> (FormResult [Posting], [(Int, (Text, Text, Maybe Text, Maybe Text))])
validatePostings :: FormResult [Text]
-> FormResult [Text]
-> (FormResult [Posting],
[(Int, (Text, Text, Maybe Text, Maybe Text))])
validatePostings FormResult [Text]
acctsRes FormResult [Text]
amtsRes = let
rows :: [(Text, Text)]
rows :: [(Text, Text)]
rows = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= (Text
"", Text
"")) forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> [(a, a)]
zipDefault Text
"" (forall a. a -> FormResult a -> a
formSuccess [] FormResult [Text]
acctsRes) (forall a. a -> FormResult a -> a
formSuccess [] FormResult [Text]
amtsRes)
postings :: [(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
postings :: [(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
postings = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (Bool, [(Text, Text)])
-> Maybe
((Text, Text, Either (Maybe Text, Maybe Text) Posting),
(Bool, [(Text, Text)]))
go (Bool
True, [(Text, Text)]
rows)
where
go :: (Bool, [(Text, Text)])
-> Maybe
((Text, Text, Either (Maybe Text, Maybe Text) Posting),
(Bool, [(Text, Text)]))
go (Bool
True, (Text
x, Text
""):(Text, Text)
y:[(Text, Text)]
xs) = forall a. a -> Maybe a
Just ((Text
x, Text
"", forall {a} {a}.
Either a Text
-> Either a Amount -> Either (Maybe a, Maybe a) Posting
zipRow (Text -> Either Text Text
checkAccount Text
x) (forall a b. a -> Either a b
Left Text
"Missing amount")), (Bool
True, (Text, Text)
yforall a. a -> [a] -> [a]
:[(Text, Text)]
xs))
go (Bool
True, (Text
x, Text
""):[(Text, Text)]
xs) = forall a. a -> Maybe a
Just ((Text
x, Text
"", forall {a} {a}.
Either a Text
-> Either a Amount -> Either (Maybe a, Maybe a) Posting
zipRow (Text -> Either Text Text
checkAccount Text
x) (forall a b. b -> Either a b
Right Amount
missingamt)), (Bool
False, [(Text, Text)]
xs))
go (Bool
False, (Text
x, Text
""):[(Text, Text)]
xs) = forall a. a -> Maybe a
Just ((Text
x, Text
"", forall {a} {a}.
Either a Text
-> Either a Amount -> Either (Maybe a, Maybe a) Posting
zipRow (Text -> Either Text Text
checkAccount Text
x) (forall a b. a -> Either a b
Left Text
"Missing amount")), (Bool
False, [(Text, Text)]
xs))
go (Bool
_, (Text
"", Text
y):[(Text, Text)]
xs) = forall a. a -> Maybe a
Just ((Text
"", Text
y, forall {a} {a}.
Either a Text
-> Either a Amount -> Either (Maybe a, Maybe a) Posting
zipRow (forall a b. a -> Either a b
Left Text
"Missing account") (Text -> Either Text Amount
checkAmount Text
y)), (Bool
False, [(Text, Text)]
xs))
go (Bool
_, (Text
x, Text
y):[(Text, Text)]
xs) = forall a. a -> Maybe a
Just ((Text
x, Text
y, forall {a} {a}.
Either a Text
-> Either a Amount -> Either (Maybe a, Maybe a) Posting
zipRow (Text -> Either Text Text
checkAccount Text
x) (Text -> Either Text Amount
checkAmount Text
y)), (Bool
True, [(Text, Text)]
xs))
go (Bool
_, []) = forall a. Maybe a
Nothing
zipRow :: Either a Text
-> Either a Amount -> Either (Maybe a, Maybe a) Posting
zipRow (Left a
e) (Left a
e') = forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just a
e, forall a. a -> Maybe a
Just a
e')
zipRow (Left a
e) (Right Amount
_) = forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just a
e, forall a. Maybe a
Nothing)
zipRow (Right Text
_) (Left a
e) = forall a b. a -> Either a b
Left (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just a
e)
zipRow (Right Text
acct') (Right Amount
amt) = forall a b. b -> Either a b
Right (Posting
nullposting {paccount :: Text
paccount = Text
acct, ptype :: PostingType
ptype = PostingType
atype, pamount :: MixedAmount
pamount = Amount -> MixedAmount
mixedAmount Amount
amt})
where
acct :: Text
acct = Text -> Text
accountNameWithoutPostingType Text
acct'
atype :: PostingType
atype = Text -> PostingType
accountNamePostingType Text
acct'
errorToFormMsg :: Either HledgerParseErrors c -> Either Text c
errorToFormMsg = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Text
"Invalid value: " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\FilePath
s ParseError Text HledgerParseErrorData
a -> FilePath
s forall a. Semigroup a => a -> a -> a
<> forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> FilePath
parseErrorTextPretty ParseError Text HledgerParseErrorData
a) FilePath
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall s e. ParseErrorBundle s e -> NonEmpty (ParseError s e)
bundleErrors)
checkAccount :: Text -> Either Text Text
checkAccount = forall {c}. Either HledgerParseErrors c -> Either Text c
errorToFormMsg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *). TextParser m Text
accountnamep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) FilePath
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip
checkAmount :: Text -> Either Text Amount
checkAmount = forall {c}. Either HledgerParseErrors c -> Either Text c
errorToFormMsg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
runParser (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (m :: * -> *). JournalParser m Amount
amountp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) Journal
nulljournal) FilePath
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip
result :: [(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
result :: [(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
result = case (FormResult [Text]
acctsRes, FormResult [Text]
amtsRes) of
(FormResult [Text]
FormMissing, FormResult [Text]
FormMissing) -> [(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
postings
(FormResult [Text], FormResult [Text])
_ -> case [(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
postings of
[] -> [ (Text
"", Text
"", forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just Text
"Missing account", forall a. a -> Maybe a
Just Text
"Missing amount"))
, (Text
"", Text
"", forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just Text
"Missing account", forall a. Maybe a
Nothing))
]
[(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
xs -> [(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
xs
display' :: [(Text, Text, Maybe Text, Maybe Text)]
display' = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
result forall a b. (a -> b) -> a -> b
$ \(Text
acc, Text
amt, Either (Maybe Text, Maybe Text) Posting
res) -> case Either (Maybe Text, Maybe Text) Posting
res of
Left (Maybe Text
mAccountErr, Maybe Text
mAmountErr) -> (Text
acc, Text
amt, Maybe Text
mAccountErr, Maybe Text
mAmountErr)
Right Posting
_ -> (Text
acc, Text
amt, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
display :: [(Text, Text, Maybe Text, Maybe Text)]
display = [(Text, Text, Maybe Text, Maybe Text)]
display' forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
4 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text, Maybe Text, Maybe Text)]
display') (Text
"", Text
"", forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
formResult :: FormResult [Posting]
formResult = case forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Text
_, Text
_, Either (Maybe Text, Maybe Text) Posting
x) -> Either (Maybe Text, Maybe Text) Posting
x) [(Text, Text, Either (Maybe Text, Maybe Text) Posting)]
result of
Left (Maybe Text, Maybe Text)
_ -> forall a. [Text] -> FormResult a
FormFailure [Text
"Postings validation failed"]
Right [Posting]
xs -> forall a. a -> FormResult a
FormSuccess [Posting]
xs
in (FormResult [Posting]
formResult, forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1 :: Int)..] [(Text, Text, Maybe Text, Maybe Text)]
display)
toBloodhoundJson :: [Text] -> Markup
toBloodhoundJson :: [Text] -> Markup
toBloodhoundJson [Text]
ts =
Text -> Markup
preEscapedText forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [
Text
"[",
Text -> [Text] -> Text
T.intercalate Text
"," forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (
(Text
"{\"value\":" forall a. Semigroup a => a -> a -> a
<>)forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(forall a. Semigroup a => a -> a -> a
<> Text
"}")forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Text
b64wrap
) [Text]
ts,
Text
"]"
]
where
b64wrap :: Text -> Text
b64wrap = (Text
"decodeBase64EncodedText(\""forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<>Text
"\")") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
encodeBase64
zipDefault :: a -> [a] -> [a] -> [(a, a)]
zipDefault :: forall a. a -> [a] -> [a] -> [(a, a)]
zipDefault a
def (a
b:[a]
bs) (a
c:[a]
cs) = (a
b, a
c)forall a. a -> [a] -> [a]
:(forall a. a -> [a] -> [a] -> [(a, a)]
zipDefault a
def [a]
bs [a]
cs)
zipDefault a
def (a
b:[a]
bs) [] = (a
b, a
def)forall a. a -> [a] -> [a]
:(forall a. a -> [a] -> [a] -> [(a, a)]
zipDefault a
def [a]
bs [])
zipDefault a
def [] (a
c:[a]
cs) = (a
def, a
c)forall a. a -> [a] -> [a]
:(forall a. a -> [a] -> [a] -> [(a, a)]
zipDefault a
def [] [a]
cs)
zipDefault a
_ [a]
_ [a]
_ = []
formSuccess :: a -> FormResult a -> a
formSuccess :: forall a. a -> FormResult a -> a
formSuccess a
def FormResult a
res = case FormResult a
res of
FormSuccess a
x -> a
x
FormResult a
_ -> a
def