-- sflc-ledger-reports: web interface to hledger-based reports
--  Copyright (C) 2013  Clint Adams
--
--  This program is free software: you can redistribute it and/or modify
--  it under the terms of the GNU Affero General Public License as
--  published by the Free Software Foundation, either version 3 of the
--  License, or (at your option) any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU Affero General Public License for more details.
--
--  You should have received a copy of the GNU Affero General Public License
--  along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Hledger.JournalCSVs (pAndL, assets, liabilities, everything, JReportType(..)) where

import Prelude (Enum(..), Integer, Int, Eq, Show, (.), ($), (*), (+), (++), (==), (>>=), (=<<), const, div, lookup, map, mod, subtract, flip, fromIntegral, fst, return, snd, head, last, error, uncurry, Maybe(..), Bool(..), Either(..), IO, FilePath, Read)
import Control.Applicative (liftA2)
import Control.Monad (ap, when)
import Data.Conduit (runConduit, (.|))
import qualified Data.Conduit.List as CL
import Data.CSV.Conduit (fromCSV, defCSVSettings, runResourceT)
import Data.List (nub, sort, sortBy)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import qualified Data.Text as T
import Data.Time.Calendar (fromGregorian, toGregorian, Day(..))
import Data.Time.Format (formatTime)
import Data.Time.Format (defaultTimeLocale)

import Hledger.Data.Amount (showMixedAmount)
import Hledger.Data.Journal (journalProfitAndLossAccountQuery, journalAssetAccountQuery, journalLiabilityAccountQuery)
import Hledger.Data.Types (DateSpan(..), Journal(..), Transaction(..), MixedAmount (..))
import Hledger.Query (Query(..))
import Hledger.Read (readJournalFile, definputopts)
import Hledger.Reports (balanceReport, defreportopts, ReportOpts(..))

showMixedAmountT :: MixedAmount -> T.Text
showMixedAmountT = T.pack . showMixedAmount

data JReportType = PandL | Assets | Liabilities | Everything
    deriving (Eq, Read, Show)

pAndL :: FilePath -> IO T.Text
pAndL fn = fn2CSV (journalProfitAndLossAccountQuery) fn

assets :: FilePath -> IO T.Text
assets fn = fn2CSV (journalAssetAccountQuery) fn

liabilities :: FilePath -> IO T.Text
liabilities fn = fn2CSV (journalLiabilityAccountQuery) fn

everything :: FilePath -> IO T.Text
everything fn = fn2CSV (const Any) fn

fn2CSV :: (Journal -> Query) -> FilePath -> IO T.Text
fn2CSV q fn = readJournalFile definputopts fn >>= \(Right j) -> jToCSV True j (q j)

-- sign-change Income lines

newtype YearMonth = YearMonth { unYM :: (Integer,Int) }
    deriving (Eq, Show)
instance Enum YearMonth where
    toEnum = YearMonth . liftA2 (,) (fromIntegral . (`div` 12)) ((1 +) . (`mod` 12))
    fromEnum = ap ((+) . (12 *) . fromIntegral . fst) (subtract 1 . snd) . unYM

dayToYearMonth :: Day -> YearMonth
dayToYearMonth = YearMonth . (\(x,y,_) -> (x,y)) . toGregorian

yearMonthToDay :: YearMonth -> Day
yearMonthToDay = uncurry (flip flip 1 . fromGregorian) . unYM

jToCSV :: Bool -> Journal -> Query -> IO (T.Text)
jToCSV delta jnl q = do
    let sortedtrans = sortBy (comparing tdate) (jtxns jnl)
        firstTxn = tdate (head sortedtrans)
        lastTxn = tdate (last sortedtrans)
        firstMonth = dayToYearMonth firstTxn
        lastMonth = dayToYearMonth lastTxn
        q' mon = And [q, Date (dS delta mon)]
    when (firstMonth == lastMonth) $ error "Need multiple months"
    let reports = map (\m -> balanceReport defreportopts { no_elide_ = True } (q' m) jnl) [firstMonth..lastMonth]
        reportT = balanceReport defreportopts { no_elide_ = True } Any jnl
        reports' = map (map (\(n, _, _, a) -> (n, showMixedAmountT a)) . fst) reports
        reportT' = (map (\(n, _, _, a) -> (n, showMixedAmountT a)) . fst) reportT
        allaccounts = sort . nub . (map fst =<<) $ reports'
        concordant = map (\x -> x : fetchSeries reports' x ++ fetchSeries [reportT'] x) allaccounts
        withheader = ("Account":map (T.pack . formatTime defaultTimeLocale "%b of %Y" . yearMonthToDay) [firstMonth..lastMonth] ++ ["Period Total"]):concordant
    c <- runResourceT . runConduit $
           CL.sourceList withheader .| fromCSV defCSVSettings .| CL.consume
    return $ T.concat c

dS :: Bool -> YearMonth -> DateSpan
dS delta (YearMonth (y,m)) = DateSpan (if delta then Just startD else Nothing) (Just endD)
    where
        startD = fromGregorian y m 01
        endD = fromGregorian y m 31

fetchSeries :: [[(T.Text, T.Text)]] -> T.Text -> [T.Text]
fetchSeries rs a = map (fromMaybe "$0.00" . lookup a) rs