path: root/favorites.f90

! Copyright (c) 2020 Jeffrey Armstrong <jeff@rainbow-100.com>
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in
! all copies or substantial portions of the Software.
!
! The Software shall be used for Good, not Evil.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
! SOFTWARE.

module favorite_handling
implicit none

    private
    
    public :: favorite, sort_added, sort_alpha, read_favorites, &
              write_favorites, add_favorite, remove_favorite, &
              is_favorite

    type :: favorite
    
        character(1024)::name
        character(1024)::link
        integer::added
        
    end type favorite
    
contains

    pure function string_compare(s1, s2) result(res)
    implicit none
    
        character(*), intent(in)::s1, s2
        integer::res
        
        integer::n1, n2
        integer::i
        
        n1 = len_trim(s1)
        n2 = len_trim(s2)
        
        res = 0
        do i = 1, min(n1, n2)
            
            if(s1(i:i) < s2(i:i)) then
                res = -1
                exit
            else if(s1(i:i) > s2(i:i)) then
                res = 1
                exit
            end if
            
        end do
        
    end function string_compare
    
    pure function string_location(array, minsearch) result(res)
    implicit none
    
        character(*), dimension(:), intent(in)::array
        logical, intent(in), optional::minsearch
        integer::res
        
        logical::mymin
        integer::i
        
        mymin = .false.
        if(present(minsearch)) then
            mymin = minsearch
        end if
    
        res = 1
        do i = 2, size(array)
            if(mymin .and. string_compare(array(res), array(i)) > 0) then
                res = i
            else if((.not. mymin) .and. string_compare(array(res), array(i)) < 0) then
                res = i
            end if
        end do
    
    end function string_location

    subroutine sort_added(favorites, latest)
    implicit none
        
        type(favorite), dimension(:), intent(inout)::favorites
        logical, intent(in)::latest
        
        integer::i_loc
        integer::i, n
        
        type(favorite)::swapper
        
        n = size(favorites)
        do i=1, n-1
        
            if(latest) then
                i_loc = maxloc(favorites(i:n)%added, 1)
            else
                i_loc = minloc(favorites(i:n)%added, 1)
            end if
            
            i_loc = i_loc + i - 1
            
            if(i /= i_loc) then
                swapper = favorites(i)
                favorites(i) = favorites(i_loc)
                favorites(i_loc) = swapper
            end if
        
        end do
    
    end subroutine sort_added
    
    subroutine sort_alpha(favorites, descending)
    implicit none
        
        type(favorite), dimension(:), intent(inout)::favorites
        logical, intent(in)::descending
        
        integer::i_loc
        integer::i, n
        
        type(favorite)::swapper
    
        n = size(favorites)
        do i=1, n-1
        
            if(descending) then
                i_loc = string_location(favorites(i:n)%name)
            else
                i_loc = string_location(favorites(i:n)%name, minsearch=.true.)
            end if
            
            i_loc = i_loc + i - 1
            
            if(i /= i_loc) then
                swapper = favorites(i)
                favorites(i) = favorites(i_loc)
                favorites(i_loc) = swapper
            end if
        
        end do
    
    end subroutine sort_alpha
    
    function read_favorite(unit_number) result(res)
    implicit none
    
        type(favorite)::res
        integer, intent(in)::unit_number
    
        character::c
        character(len=10)::text_date
        integer::i, ios
        
        ! Leading spaces...
        read(unit_number, '(A1)', advance='no') c
        do while(c == ' ' .or. c == char(9))
            read(unit_number, '(A1)', advance='no') c
        end do
        
        ! Link
        res%link = " "
        i = 1
        do while(c /= ' ' .and. c /= char(9))
            res%link(i:i) = c
            read(unit_number, '(A1)', advance='no') c
            i = i + 1
        end do
        
        ! Separating spaces...
        do while(c == ' ' .or. c == char(9))
            read(unit_number, '(A1)', advance='no') c
        end do
        
        ! Name...
        res%name = " "
        ios = 0
        i = 1
        do while(ios == 0)
            res%name(i:i) = c
            read(unit_number, '(A1)', advance='no', iostat=ios) c
            i = i + 1
        end do
        
        ! The date should be at the end of the link
        i = index(res%name, "(", .true.)
        text_date = res%name(i+1:i+10)
        do i = 5, 9
            text_date(i:i) = text_date(i+1:i+1)
        end do
        do i = 7, 8
            text_date(i:i) = text_date(i+1:i+1)
        end do
        read(text_date, '(I8)') res%added
    
    end function read_favorite
    
    function read_favorites(unit_number) result(faves)
    implicit none
        
        integer, intent(in)::unit_number
        type(favorite), dimension(:), pointer::faves
        
        character(80)::temp
        integer::n, i, ios
        
        faves => null()
        
        ! Title
        read(unit_number, *, iostat=ios) temp
        if(ios /= 0) then
            return
        end if
        
        ! Blank
        !read(unit_number, *) temp
        
        ! Count
        read(unit_number, *, iostat=ios) n
        if(ios /= 0) then
            return
        end if
        
        ! Blank
        !read(unit_number, *) temp
        
        allocate(faves(n))
        
        do i = 1, n
            ios = 1
            do while(ios /= 0)
                read(unit_number, '(A2)', advance='no', iostat=ios) temp
            end do
            faves(i) = read_favorite(unit_number)
        end do
        
    end function read_favorites
    
    subroutine write_favorite(unit_number, f)
    implicit none
    
        integer, intent(in)::unit_number
        type(favorite), intent(in)::f
    
        write(unit_number, '(A2)', advance='no') "=>"
        write(unit_number, *) trim(f%link)//" "//trim(f%name)
    
    end subroutine write_favorite
        
    subroutine write_favorites(unit_number, faves, skip_heading)
    implicit none
    
        integer, intent(in)::unit_number
        type(favorite), dimension(:), intent(in), pointer::faves
        logical, intent(in), optional::skip_heading
    
        integer::i
        character(8)::n_text
    
        if(present(skip_heading)) then
            if(.not. skip_heading) then
                write(unit_number, '(A11)') "# Favorites"
                write(unit_number, *)
            end if
        else
            write(unit_number, '(A11)') "# Favorites"
            write(unit_number, *)
        end if
        
        if(.not.associated(faves)) then
            return
        end if
        
        write(n_text, '(I8)') size(faves)
        
        write(unit_number, *) trim(adjustl(n_text))//" Links Are Marked As Favorites"
        write(unit_number, *)
        
        do i = 1, size(faves)
            call write_favorite(unit_number, faves(i))
        end do
    
    end subroutine write_favorites
    
    pure function find_favorite(faves, link)
    implicit none
    
        integer::find_favorite
        type(favorite), dimension(:), intent(in), pointer::faves
        character(*), intent(in)::link
        
        if(.not. associated(faves)) then
            find_favorite = -1
        else
            do find_favorite = 1, size(faves)
                if(trim(link) == trim(faves(find_favorite)%link)) then
                    exit
                end if
            end do
            
            if(find_favorite > size(faves)) then
                find_favorite = -1
            end if
        end if
    
    end function find_favorite
    
    subroutine add_favorite(faves, link, name)
    implicit none
    
        type(favorite), dimension(:), intent(inout), pointer::faves
        character(*), intent(in)::link
        character(*), intent(in)::name
        character(8)::now
        
        integer::n
        type(favorite), dimension(:), pointer::holding
        
        n = -1
        
        if(.not. associated(faves)) then
        
            n = 1
            allocate(faves(1))
        
        else if(find_favorite(faves, link) < 0) then
            
            n = size(faves)
            holding => faves
            
            faves => null()
            
            allocate(faves(n+1))
            faves(1:n) = holding
            
            n = n + 1
            
            deallocate(holding)
            
        end if
            
        if(n > 0) then
            faves(n)%link = trim(link)
            
            call date_and_time(date=now)
            faves(n)%name = trim(name)//" ("//now(1:4)//"-"//now(5:6)//"-"//now(7:8)//")"
            read(now, '(I8)') faves(n)%added
        end if
        
    end subroutine add_favorite
    
    subroutine remove_favorite(faves, link)
    implicit none
        
        type(favorite), dimension(:), intent(inout), pointer::faves
        character(*), intent(in)::link
        
        integer::i, n
        type(favorite), dimension(:), allocatable::holding
        
        i = find_favorite(faves, link)
        if(i > 0) then
        
            if(size(faves) == 1) then
                
                deallocate(faves)
            
            else
        
                n = size(faves)
                
                allocate(holding(n-1))
                if(i > 1) then
                    holding(1:i-1) = faves(1:i-1)
                end if
                if(i < n) then
                    holding(i:n-1) = faves(i+1:n)
                end if
                deallocate(faves)
                
                allocate(faves(n-1))
                faves = holding
                deallocate(holding)
        
            end if
            
        end if
        
    end subroutine remove_favorite
    
    function is_favorite(faves, link)
    implicit none 
    
        type(favorite), dimension(:), intent(in), pointer::faves
        character(*), intent(in)::link
        logical::is_favorite
        
        is_favorite = .false.
        
        if(associated(faves)) then
            is_favorite = (find_favorite(faves, link) > 0)
        end if
        
    end function is_favorite
    
end module favorite_handling