{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE QuasiQuotes          #-}
module Hledger.Cli.Anchor (
    setAccountAnchor,
    dateCell,
    dateSpanCell,
    headerDateSpanCell,
    ) where

import qualified Data.Text as Text
import Data.Text (Text)
import Data.Time (Day)
import Data.Maybe (fromMaybe)

import qualified Text.URI as Uri
import qualified Text.URI.QQ as UriQQ

import qualified Hledger.Write.Spreadsheet as Spr
import Hledger.Write.Spreadsheet (headerCell)
import Hledger.Utils.IO (error')
import Hledger.Utils.Text (quoteIfSpaced)
import Hledger.Data.Dates (showDateSpan, showDate)
import Hledger.Data.Types (DateSpan)


registerQueryUrl :: [Text] -> Text
registerQueryUrl :: [Text] -> Text
registerQueryUrl [Text]
query =
    URI -> Text
Uri.render (URI -> Text) -> URI -> Text
forall a b. (a -> b) -> a -> b
$
    [UriQQ.uri|register|] {
        Uri.uriQuery =
            [Uri.QueryParam [UriQQ.queryKey|q|] $
             fromMaybe (error' "register URI query construction failed") $
             Uri.mkQueryValue $ Text.unwords $
             map quoteIfSpaced $ filter (not . Text.null) query]
    }

{- |
>>> composeAnchor Nothing ["date:2024"]
""
>>> composeAnchor (Just "") ["date:2024"]
"register?q=date:2024"
>>> composeAnchor (Just "/") ["date:2024"]
"/register?q=date:2024"
>>> composeAnchor (Just "foo") ["date:2024"]
"foo/register?q=date:2024"
>>> composeAnchor (Just "foo/") ["date:2024"]
"foo/register?q=date:2024"
-}
composeAnchor :: Maybe Text -> [Text] -> Text
composeAnchor :: Maybe Text -> [Text] -> Text
composeAnchor Maybe Text
Nothing [Text]
_ = Text
forall a. Monoid a => a
mempty
composeAnchor (Just Text
baseUrl) [Text]
query =
    Text
baseUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    (if ((Text, Char) -> Bool) -> Maybe (Text, Char) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Char
'/'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (Char -> Bool) -> ((Text, Char) -> Char) -> (Text, Char) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Char) -> Char
forall a b. (a, b) -> b
snd) (Maybe (Text, Char) -> Bool) -> Maybe (Text, Char) -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Maybe (Text, Char)
Text.unsnoc Text
baseUrl then Text
"" else Text
"/") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    [Text] -> Text
registerQueryUrl [Text]
query

-- cf. Web.Widget.Common
removeDates :: [Text] -> [Text]
removeDates :: [Text] -> [Text]
removeDates =
    (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Text
term_ ->
        Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
Text.isPrefixOf Text
"date:" Text
term_ Bool -> Bool -> Bool
|| Text -> Text -> Bool
Text.isPrefixOf Text
"date2:" Text
term_)

replaceDate :: Text -> [Text] -> [Text]
replaceDate :: Text -> [Text] -> [Text]
replaceDate Text
prd [Text]
query = Text
"date:"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
prd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
removeDates [Text]
query

headerDateSpanCell ::
    Maybe Text -> [Text] -> DateSpan -> Spr.Cell () Text
headerDateSpanCell :: Maybe Text -> [Text] -> DateSpan -> Cell () Text
headerDateSpanCell Maybe Text
base [Text]
query DateSpan
spn =
    let prd :: Text
prd = DateSpan -> Text
showDateSpan DateSpan
spn in
    (Text -> Cell () Text
forall borders. Lines borders => Text -> Cell borders Text
headerCell Text
prd) {
        Spr.cellAnchor = composeAnchor base $ replaceDate prd query
    }


dateQueryCell ::
    (Spr.Lines border) =>
    Maybe Text -> [Text] -> Text -> Text -> Spr.Cell border Text
dateQueryCell :: forall border.
Lines border =>
Maybe Text -> [Text] -> Text -> Text -> Cell border Text
dateQueryCell Maybe Text
base [Text]
query Text
acct Text
dateTerm =
    (Text -> Cell border Text
forall border text. Lines border => text -> Cell border text
Spr.defaultCell Text
dateTerm) {
        Spr.cellAnchor =
            composeAnchor base $ "inacct:"<>acct : replaceDate dateTerm query
    }

dateCell ::
    (Spr.Lines border) =>
    Maybe Text -> [Text] -> Text -> Day -> Spr.Cell border Text
dateCell :: forall border.
Lines border =>
Maybe Text -> [Text] -> Text -> Day -> Cell border Text
dateCell Maybe Text
base [Text]
query Text
acct = Maybe Text -> [Text] -> Text -> Text -> Cell border Text
forall border.
Lines border =>
Maybe Text -> [Text] -> Text -> Text -> Cell border Text
dateQueryCell Maybe Text
base [Text]
query Text
acct (Text -> Cell border Text)
-> (Day -> Text) -> Day -> Cell border Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text
showDate

dateSpanCell ::
    (Spr.Lines border) =>
    Maybe Text -> [Text] -> Text -> DateSpan -> Spr.Cell border Text
dateSpanCell :: forall border.
Lines border =>
Maybe Text -> [Text] -> Text -> DateSpan -> Cell border Text
dateSpanCell Maybe Text
base [Text]
query Text
acct = Maybe Text -> [Text] -> Text -> Text -> Cell border Text
forall border.
Lines border =>
Maybe Text -> [Text] -> Text -> Text -> Cell border Text
dateQueryCell Maybe Text
base [Text]
query Text
acct (Text -> Cell border Text)
-> (DateSpan -> Text) -> DateSpan -> Cell border Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateSpan -> Text
showDateSpan

setAccountAnchor ::
    Maybe Text -> [Text] -> Text -> Spr.Cell border text -> Spr.Cell border text
setAccountAnchor :: forall border text.
Maybe Text
-> [Text] -> Text -> Cell border text -> Cell border text
setAccountAnchor Maybe Text
base [Text]
query Text
acct Cell border text
cell =
    Cell border text
cell {Spr.cellAnchor = composeAnchor base $ "inacct:"<>acct : query}