457 lines
21 KiB
Haskell
457 lines
21 KiB
Haskell
{-|
|
|
A history-aware add command to help with data entry.
|
|
|-}
|
|
|
|
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}
|
|
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts, OverloadedStrings, PackageImports #-}
|
|
|
|
module Hledger.Cli.Commands.Add (
|
|
addmode
|
|
,add
|
|
,appendToJournalFileOrStdout
|
|
,journalAddTransaction
|
|
,transactionsSimilarTo
|
|
)
|
|
where
|
|
|
|
import Prelude ()
|
|
import "base-compat-batteries" Prelude.Compat
|
|
import Control.Exception as E
|
|
import Control.Monad
|
|
import Control.Monad.Trans.Class
|
|
import Control.Monad.State.Strict (evalState, evalStateT)
|
|
import Control.Monad.Trans (liftIO)
|
|
import Data.Char (toUpper, toLower)
|
|
import Data.Functor.Identity (Identity(..))
|
|
import "base-compat-batteries" Data.List.Compat
|
|
import qualified Data.Set as S
|
|
import Data.Maybe
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import Data.Time.Calendar (Day)
|
|
import Data.Typeable (Typeable)
|
|
import Safe (headDef, headMay)
|
|
import System.Console.CmdArgs.Explicit
|
|
import System.Console.Haskeline (runInputT, defaultSettings, setComplete)
|
|
import System.Console.Haskeline.Completion
|
|
import System.Console.Wizard
|
|
import System.Console.Wizard.Haskeline
|
|
import System.IO ( stderr, hPutStr, hPutStrLn )
|
|
import Text.Megaparsec
|
|
import Text.Megaparsec.Char
|
|
import Text.Printf
|
|
|
|
import Hledger
|
|
import Hledger.Cli.CliOptions
|
|
import Hledger.Cli.Commands.Register (postingsReportAsText)
|
|
|
|
|
|
addmode = (defCommandMode ["add"]) {
|
|
modeHelp = "prompt for transactions and add them to the journal"
|
|
,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."]
|
|
,modeGroupFlags = Group {
|
|
groupUnnamed = [
|
|
flagNone ["no-new-accounts"] (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"
|
|
]
|
|
,groupHidden = []
|
|
,groupNamed = [generalflagsgroup2]
|
|
}
|
|
}
|
|
|
|
-- | State used while entering transactions.
|
|
data EntryState = EntryState {
|
|
esOpts :: CliOpts -- ^ command line options
|
|
,esArgs :: [String] -- ^ command line arguments remaining to be used as defaults
|
|
,esToday :: Day -- ^ today's date
|
|
,esDefDate :: Day -- ^ the default date for next transaction
|
|
,esJournal :: Journal -- ^ the journal we are adding to
|
|
,esSimilarTransaction :: Maybe Transaction -- ^ the most similar historical txn
|
|
,esPostings :: [Posting] -- ^ postings entered so far in the current txn
|
|
} deriving (Show,Typeable)
|
|
|
|
defEntryState = EntryState {
|
|
esOpts = defcliopts
|
|
,esArgs = []
|
|
,esToday = nulldate
|
|
,esDefDate = nulldate
|
|
,esJournal = nulljournal
|
|
,esSimilarTransaction = Nothing
|
|
,esPostings = []
|
|
}
|
|
|
|
data RestartTransactionException = RestartTransactionException deriving (Typeable,Show)
|
|
instance Exception RestartTransactionException
|
|
|
|
-- data ShowHelpException = ShowHelpException deriving (Typeable,Show)
|
|
-- instance Exception ShowHelpException
|
|
|
|
-- | Read multiple transactions from the console, prompting for each
|
|
-- field, and append them to the journal file. If the journal came
|
|
-- from stdin, this command has no effect.
|
|
add :: CliOpts -> Journal -> IO ()
|
|
add opts j
|
|
| journalFilePath j == "-" = return ()
|
|
| otherwise = do
|
|
hPrintf stderr "Adding transactions to journal file %s\n" (journalFilePath j)
|
|
showHelp
|
|
today <- getCurrentDay
|
|
let es = defEntryState{esOpts=opts
|
|
,esArgs=map (T.unpack . stripquotes . T.pack) $ listofstringopt "args" $ rawopts_ opts
|
|
,esToday=today
|
|
,esDefDate=today
|
|
,esJournal=j
|
|
}
|
|
getAndAddTransactions es `E.catch` (\(_::UnexpectedEOF) -> putStr "")
|
|
|
|
showHelp = hPutStr stderr $ unlines [
|
|
"Any command line arguments will be used as defaults."
|
|
,"Use tab key to complete, readline keys to edit, enter to accept defaults."
|
|
,"An optional (CODE) may follow transaction dates."
|
|
,"An optional ; COMMENT may follow descriptions or amounts."
|
|
,"If you make a mistake, enter < at any prompt to restart the transaction."
|
|
,"To end a transaction, enter . when prompted."
|
|
,"To quit, enter . at a date prompt or press control-d or control-c."
|
|
]
|
|
|
|
-- | Loop reading transactions from the console, prompting, validating
|
|
-- and appending each one to the journal file, until end of input or
|
|
-- ctrl-c (then raise an EOF exception). If provided, command-line
|
|
-- arguments are used as defaults; otherwise defaults come from the
|
|
-- most similar recent transaction in the journal.
|
|
getAndAddTransactions :: EntryState -> IO ()
|
|
getAndAddTransactions es@EntryState{..} = (do
|
|
mt <- runInputT (setComplete noCompletion defaultSettings) (run $ haskeline $ confirmedTransactionWizard es)
|
|
case mt of
|
|
Nothing -> fail "urk ?"
|
|
Just t -> do
|
|
j <- if debug_ esOpts > 0
|
|
then do hPrintf stderr "Skipping journal add due to debug mode.\n"
|
|
return esJournal
|
|
else do j' <- journalAddTransaction esJournal esOpts t
|
|
hPrintf stderr "Saved.\n"
|
|
return j'
|
|
hPrintf stderr "Starting the next transaction (. or ctrl-D/ctrl-C to quit)\n"
|
|
getAndAddTransactions es{esJournal=j, esDefDate=tdate t}
|
|
)
|
|
`E.catch` (\(_::RestartTransactionException) ->
|
|
hPrintf stderr "Restarting this transaction.\n" >> getAndAddTransactions es)
|
|
|
|
-- confirmedTransactionWizard :: (ArbitraryIO :<: b, OutputLn :<: b, Line :<: b) => EntryState -> Wizard b Transaction
|
|
-- confirmedTransactionWizard :: EntryState -> Wizard Haskeline Transaction
|
|
confirmedTransactionWizard es@EntryState{..} = do
|
|
t <- transactionWizard es
|
|
-- liftIO $ hPrintf stderr {- "Transaction entered:\n%s" -} (show t)
|
|
output $ show t
|
|
y <- let def = "y" in
|
|
retryMsg "Please enter y or n." $
|
|
parser ((fmap ('y' ==)) . headMay . map toLower . strip) $
|
|
defaultTo' def $ nonEmpty $
|
|
maybeRestartTransaction $
|
|
line $ green $ printf "Save this transaction to the journal ?%s: " (showDefault def)
|
|
if y then return t else throw RestartTransactionException
|
|
|
|
transactionWizard es@EntryState{..} = do
|
|
(date,code) <- dateAndCodeWizard es
|
|
let es1@EntryState{esArgs=args1} = es{esArgs=drop 1 esArgs, esDefDate=date}
|
|
(desc,comment) <- descriptionAndCommentWizard es1
|
|
let mbaset = similarTransaction es1 desc
|
|
when (isJust mbaset) $ liftIO $ hPrintf stderr "Using this similar transaction for defaults:\n%s" (show $ fromJust mbaset)
|
|
let es2 = es1{esArgs=drop 1 args1, esSimilarTransaction=mbaset}
|
|
balancedPostingsWizard = do
|
|
ps <- postingsWizard es2{esPostings=[]}
|
|
let t = nulltransaction{tdate=date
|
|
,tstatus=Unmarked
|
|
,tcode=code
|
|
,tdescription=desc
|
|
,tcomment=comment
|
|
,tpostings=ps
|
|
}
|
|
case balanceTransaction Nothing t of -- imprecise balancing (?)
|
|
Right t' -> return t'
|
|
Left err -> liftIO (hPutStrLn stderr $ "\n" ++ (capitalize err) ++ "please re-enter.") >> balancedPostingsWizard
|
|
balancedPostingsWizard
|
|
|
|
-- Identify the closest recent match for this description in past transactions.
|
|
similarTransaction :: EntryState -> Text -> Maybe Transaction
|
|
similarTransaction EntryState{..} desc =
|
|
let q = queryFromOptsOnly esToday $ reportopts_ esOpts
|
|
historymatches = transactionsSimilarTo esJournal q desc
|
|
bestmatch | null historymatches = Nothing
|
|
| otherwise = Just $ snd $ head historymatches
|
|
in bestmatch
|
|
|
|
dateAndCodeWizard EntryState{..} = do
|
|
let def = headDef (showDate esDefDate) esArgs
|
|
retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $
|
|
parser (parseSmartDateAndCode esToday) $
|
|
withCompletion (dateCompleter def) $
|
|
defaultTo' def $ nonEmpty $
|
|
maybeExit $
|
|
maybeRestartTransaction $
|
|
-- maybeShowHelp $
|
|
line $ green $ printf "Date%s: " (showDefault def)
|
|
where
|
|
parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc
|
|
where
|
|
edc = runParser (dateandcodep <* eof) "" $ T.pack $ lowercase s
|
|
dateandcodep :: SimpleTextParser (SmartDate, Text)
|
|
dateandcodep = do
|
|
d <- smartdate
|
|
c <- optional codep
|
|
skipMany spacenonewline
|
|
eof
|
|
return (d, fromMaybe "" c)
|
|
-- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate
|
|
-- datestr = showDate $ fixSmartDate defday smtdate
|
|
|
|
descriptionAndCommentWizard EntryState{..} = do
|
|
let def = headDef "" esArgs
|
|
s <- withCompletion (descriptionCompleter esJournal def) $
|
|
defaultTo' def $ nonEmpty $
|
|
maybeRestartTransaction $
|
|
line $ green $ printf "Description%s: " (showDefault def)
|
|
let (desc,comment) = (T.pack $ strip a, T.pack $ strip $ dropWhile (==';') b) where (a,b) = break (==';') s
|
|
return (desc, comment)
|
|
|
|
postingsWizard es@EntryState{..} = do
|
|
mp <- postingWizard es
|
|
case mp of Nothing -> return esPostings
|
|
Just p -> postingsWizard es{esArgs=drop 2 esArgs, esPostings=esPostings++[p]}
|
|
|
|
postingWizard es@EntryState{..} = do
|
|
acct <- accountWizard es
|
|
if acct `elem` [".",""]
|
|
then case (esPostings, postingsBalanced esPostings) of
|
|
([],_) -> liftIO (hPutStrLn stderr "Please enter some postings first.") >> postingWizard es
|
|
(_,False) -> liftIO (hPutStrLn stderr "Please enter more postings to balance the transaction.") >> postingWizard es
|
|
(_,True) -> return Nothing -- no more postings, end of transaction
|
|
else do
|
|
let es1 = es{esArgs=drop 1 esArgs}
|
|
(amt,comment) <- amountAndCommentWizard es1
|
|
return $ Just nullposting{paccount=T.pack $ stripbrackets acct
|
|
,pamount=Mixed [amt]
|
|
,pcomment=comment
|
|
,ptype=accountNamePostingType $ T.pack acct
|
|
}
|
|
|
|
postingsBalanced :: [Posting] -> Bool
|
|
postingsBalanced ps = isRight $ balanceTransaction Nothing nulltransaction{tpostings=ps}
|
|
|
|
accountWizard EntryState{..} = do
|
|
let pnum = length esPostings + 1
|
|
historicalp = maybe Nothing (Just . (!! (pnum-1)) . (++ (repeat nullposting)) . tpostings) esSimilarTransaction
|
|
historicalacct = case historicalp of Just p -> showAccountName Nothing (ptype p) (paccount p)
|
|
Nothing -> ""
|
|
def = headDef historicalacct esArgs
|
|
endmsg | canfinish && null def = " (or . or enter to finish this transaction)"
|
|
| canfinish = " (or . to finish this transaction)"
|
|
| otherwise = ""
|
|
retryMsg "A valid hledger account name is required. Eg: assets:cash, expenses:food:eating out." $
|
|
parser (parseAccountOrDotOrNull def canfinish) $
|
|
withCompletion (accountCompleter esJournal def) $
|
|
defaultTo' def $ -- nonEmpty $
|
|
maybeRestartTransaction $
|
|
line $ green $ printf "Account %d%s%s: " pnum (endmsg::String) (showDefault def)
|
|
where
|
|
canfinish = not (null esPostings) && postingsBalanced esPostings
|
|
parseAccountOrDotOrNull :: String -> Bool -> String -> Maybe String
|
|
parseAccountOrDotOrNull _ _ "." = dbg1 $ Just "." -- . always signals end of txn
|
|
parseAccountOrDotOrNull "" True "" = dbg1 $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn
|
|
parseAccountOrDotOrNull def@(_:_) _ "" = dbg1 $ Just def -- when there's a default, "" means use that
|
|
parseAccountOrDotOrNull _ _ s = dbg1 $ fmap T.unpack $
|
|
either (const Nothing) validateAccount $
|
|
flip evalState esJournal $ runParserT (accountnamep <* eof) "" (T.pack s) -- otherwise, try to parse the input as an accountname
|
|
where
|
|
validateAccount :: Text -> Maybe Text
|
|
validateAccount t | no_new_accounts_ esOpts && not (t `elem` journalAccountNamesDeclaredOrImplied esJournal) = Nothing
|
|
| otherwise = Just t
|
|
dbg1 = id -- strace
|
|
|
|
amountAndCommentWizard EntryState{..} = do
|
|
let pnum = length esPostings + 1
|
|
(mhistoricalp,followedhistoricalsofar) =
|
|
case esSimilarTransaction of
|
|
Nothing -> (Nothing,False)
|
|
Just Transaction{tpostings=ps} -> (if length ps >= pnum then Just (ps !! (pnum-1)) else Nothing
|
|
,all (\(a,b) -> pamount a == pamount b) $ zip esPostings ps)
|
|
def = case (esArgs, mhistoricalp, followedhistoricalsofar) of
|
|
(d:_,_,_) -> d
|
|
(_,Just hp,True) -> showamt $ pamount hp
|
|
_ | pnum > 1 && not (isZeroMixedAmount balancingamt) -> showamt balancingamtfirstcommodity
|
|
_ -> ""
|
|
retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $
|
|
parser parseAmountAndComment $
|
|
withCompletion (amountCompleter def) $
|
|
defaultTo' def $ nonEmpty $
|
|
maybeRestartTransaction $
|
|
line $ green $ printf "Amount %d%s: " pnum (showDefault def)
|
|
where
|
|
parseAmountAndComment s = either (const Nothing) Just $
|
|
runParser
|
|
(evalStateT (amountandcommentp <* eof) nodefcommodityj)
|
|
""
|
|
(T.pack s)
|
|
nodefcommodityj = esJournal{jparsedefaultcommodity=Nothing}
|
|
amountandcommentp :: JournalParser Identity (Amount, Text)
|
|
amountandcommentp = do
|
|
a <- amountp
|
|
lift (skipMany spacenonewline)
|
|
c <- T.pack <$> fromMaybe "" `fmap` optional (char ';' >> many anyChar)
|
|
-- eof
|
|
return (a,c)
|
|
balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings
|
|
balancingamtfirstcommodity = Mixed $ take 1 $ amounts balancingamt
|
|
showamt =
|
|
showMixedAmountWithPrecision
|
|
-- what should this be ?
|
|
-- 1 maxprecision (show all decimal places or none) ?
|
|
-- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ?
|
|
-- 3 canonical precision for this commodity in the journal ?
|
|
-- 4 maximum precision entered so far in this transaction ?
|
|
-- 5 3 or 4, whichever would show the most decimal places ?
|
|
-- I think 1 or 4, whichever would show the most decimal places
|
|
maxprecisionwithpoint
|
|
--
|
|
-- let -- (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt
|
|
-- a = fromparse $ runParser (amountp <|> return missingamt) (jparsestate esJournal) "" amt
|
|
-- awithoutjps = fromparse $ runParser (amountp <|> return missingamt) mempty "" amt
|
|
-- defamtaccepted = Just (showAmount a) == mdefamt
|
|
-- es2 = if defamtaccepted then es1 else es1{esHistoricalPostings=Nothing}
|
|
-- mdefaultcommodityapplied = if acommodity a == acommodity awithoutjps then Nothing else Just $ acommodity a
|
|
-- when (isJust mdefaultcommodityapplied) $
|
|
-- liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied)
|
|
|
|
maybeExit = parser (\s -> if s=="." then throw UnexpectedEOF else Just s)
|
|
|
|
maybeRestartTransaction = parser (\s -> if s=="<" then throw RestartTransactionException else Just s)
|
|
|
|
-- maybeShowHelp :: Wizard Haskeline String -> Wizard Haskeline String
|
|
-- maybeShowHelp wizard = maybe (liftIO showHelp >> wizard) return $
|
|
-- parser (\s -> if s=="?" then Nothing else Just s) wizard
|
|
|
|
-- Completion helpers
|
|
|
|
dateCompleter :: String -> CompletionFunc IO
|
|
dateCompleter = completer ["today","tomorrow","yesterday"]
|
|
|
|
descriptionCompleter :: Journal -> String -> CompletionFunc IO
|
|
descriptionCompleter j = completer (map T.unpack $ journalDescriptions j)
|
|
|
|
accountCompleter :: Journal -> String -> CompletionFunc IO
|
|
accountCompleter j = completer (map T.unpack $ journalAccountNamesDeclaredOrImplied j)
|
|
|
|
amountCompleter :: String -> CompletionFunc IO
|
|
amountCompleter = completer []
|
|
|
|
-- | Generate a haskeline completion function from the given
|
|
-- completions and default, that case insensitively completes with
|
|
-- prefix matches, or infix matches above a minimum length, or
|
|
-- completes the null string with the default.
|
|
completer :: [String] -> String -> CompletionFunc IO
|
|
completer completions def = completeWord Nothing "" completionsFor
|
|
where
|
|
simpleCompletion' s = (simpleCompletion s){isFinished=False}
|
|
completionsFor "" = return [simpleCompletion' def]
|
|
completionsFor i = return (map simpleCompletion' ciprefixmatches)
|
|
where
|
|
ciprefixmatches = [c | c <- completions, i `isPrefixOf` c]
|
|
-- mixed-case completions require haskeline > 0.7.1.2
|
|
-- ciprefixmatches = [c | c <- completions, lowercase i `isPrefixOf` lowercase c]
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
-- utilities
|
|
|
|
defaultTo' = flip defaultTo
|
|
|
|
withCompletion f = withSettings (setComplete f defaultSettings)
|
|
|
|
green s = "\ESC[1;32m\STX"++s++"\ESC[0m\STX"
|
|
|
|
showDefault "" = ""
|
|
showDefault s = " [" ++ s ++ "]"
|
|
|
|
-- | Append this transaction to the journal's file and transaction list.
|
|
journalAddTransaction :: Journal -> CliOpts -> Transaction -> IO Journal
|
|
journalAddTransaction j@Journal{jtxns=ts} opts t = do
|
|
let f = journalFilePath j
|
|
appendToJournalFileOrStdout f $ showTransactionUnelided t
|
|
-- unelided shows all amounts explicitly, in case there's a price, cf #283
|
|
when (debug_ opts > 0) $ do
|
|
putStrLn $ printf "\nAdded transaction to %s:" f
|
|
putStrLn =<< registerFromString (show t)
|
|
return j{jtxns=ts++[t]}
|
|
|
|
-- | Append a string, typically one or more transactions, to a journal
|
|
-- file, or if the file is "-", dump it to stdout. Tries to avoid
|
|
-- excess whitespace.
|
|
appendToJournalFileOrStdout :: FilePath -> String -> IO ()
|
|
appendToJournalFileOrStdout f s
|
|
| f == "-" = putStr s'
|
|
| otherwise = appendFile f s'
|
|
where s' = "\n" ++ ensureOneNewlineTerminated s
|
|
|
|
-- | Replace a string's 0 or more terminating newlines with exactly one.
|
|
ensureOneNewlineTerminated :: String -> String
|
|
ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse
|
|
|
|
-- | Convert a string of journal data into a register report.
|
|
registerFromString :: String -> IO String
|
|
registerFromString s = do
|
|
d <- getCurrentDay
|
|
j <- readJournal' $ T.pack s
|
|
return $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j
|
|
where
|
|
ropts = defreportopts{empty_=True}
|
|
opts = defcliopts{reportopts_=ropts}
|
|
|
|
capitalize :: String -> String
|
|
capitalize "" = ""
|
|
capitalize (c:cs) = toUpper c : cs
|
|
|
|
-- | Find the most similar and recent transactions matching the given
|
|
-- transaction description and report query. Transactions are listed
|
|
-- with their "relevancy" score, most relevant first.
|
|
transactionsSimilarTo :: Journal -> Query -> Text -> [(Double,Transaction)]
|
|
transactionsSimilarTo j q desc =
|
|
sortBy compareRelevanceAndRecency
|
|
$ filter ((> threshold).fst)
|
|
[(compareDescriptions desc $ tdescription t, t) | t <- ts]
|
|
where
|
|
compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1)
|
|
ts = filter (q `matchesTransaction`) $ jtxns j
|
|
threshold = 0
|
|
|
|
-- | Return a similarity measure, from 0 to 1, for two transaction
|
|
-- descriptions. This is like compareStrings, but first strips out
|
|
-- any numbers, to improve accuracy eg when there are bank transaction
|
|
-- ids from imported data.
|
|
compareDescriptions :: Text -> Text -> Double
|
|
compareDescriptions s t = compareStrings s' t'
|
|
where s' = simplify $ T.unpack s
|
|
t' = simplify $ T.unpack t
|
|
simplify = filter (not . (`elem` ("0123456789" :: String)))
|
|
|
|
-- | Return a similarity measure, from 0 to 1, for two strings. This
|
|
-- was based on Simon White's string similarity algorithm
|
|
-- (http://www.catalysoft.com/articles/StrikeAMatch.html), later found
|
|
-- to be https://en.wikipedia.org/wiki/S%C3%B8rensen%E2%80%93Dice_coefficient,
|
|
-- modified to handle short strings better.
|
|
-- Todo: check out http://nlp.fi.muni.cz/raslan/2008/raslan08.pdf#page=14 .
|
|
compareStrings :: String -> String -> Double
|
|
compareStrings "" "" = 1
|
|
compareStrings (_:[]) "" = 0
|
|
compareStrings "" (_:[]) = 0
|
|
compareStrings (a:[]) (b:[]) = if toUpper a == toUpper b then 1 else 0
|
|
compareStrings s1 s2 = 2 * commonpairs / totalpairs
|
|
where
|
|
pairs1 = S.fromList $ wordLetterPairs $ uppercase s1
|
|
pairs2 = S.fromList $ wordLetterPairs $ uppercase s2
|
|
commonpairs = fromIntegral $ S.size $ S.intersection pairs1 pairs2
|
|
totalpairs = fromIntegral $ S.size pairs1 + S.size pairs2
|
|
|
|
wordLetterPairs = concatMap letterPairs . words
|
|
|
|
letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)
|
|
letterPairs _ = []
|