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

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

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

    import Hledger.Write.Spreadsheet qualified 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}