diohsc-0.1.14: History.hs

-- This file is part of Diohsc
-- Copyright (C) 2020-23 Martin Bays <mbays@sdf.org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of version 3 of the GNU General Public License as
-- published by the Free Software Foundation, or any later version.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see http://www.gnu.org/licenses/.

{-# LANGUAGE OverloadedStrings #-}

module History where
import           Data.List                (find)
import           Time.Types               (ElapsedP)

import qualified Codec.MIME.Type          as MIME
import qualified Data.Text.Encoding.Error as T
import qualified Data.Text.Lazy.Encoding  as T

import           GeminiProtocol
import           Request
import           TextGemini
import           URI

data HistoryChild = HistoryChild
    { childItem :: HistoryItem
    , childLink :: Maybe Int
    }

data HistoryOrigin = HistoryOrigin
    { originItem :: HistoryItem
    , originLink :: Maybe Int
    }

data HistoryItem = HistoryItem
    { historyRequest            :: Request
    , historyRequestTime        :: ElapsedP
    , historyMimedData          :: MimedData
    , historyGeminatedMimedData :: MimedData -- ^generated with lazy IO
    , historyParent             :: Maybe HistoryItem
    , historyChild              :: Maybe HistoryChild
    }

historyUri :: HistoryItem -> URI
historyUri = requestUri . historyRequest

historyAncestors :: HistoryItem -> [HistoryItem]
historyAncestors i = case historyParent i of
        Nothing -> []
        Just i' -> i' : historyAncestors i'

historyDescendants :: HistoryItem -> [HistoryItem]
historyDescendants i = case historyChild i of
        Nothing                  -> []
        Just (HistoryChild i' _) -> i' : historyDescendants i'

pathItemByUri :: HistoryItem -> URI -> Maybe HistoryItem
pathItemByUri i uri = find ((uri ==) . historyUri) $
    historyAncestors i ++ [i] ++ historyDescendants i

historyLinks :: HistoryItem -> [Link]
historyLinks item = case historyGeminatedMimedData item of
    MimedData (MIME.Type (MIME.Text "gemini") _) body ->
        extractLinks . parseGemini $ T.decodeUtf8With T.lenientDecode body
    _ -> []