-----------------------------------------------------------------------------
-- |
-- Module      :  Data.OrgMode.Parse.Types
-- Copyright   :  © 2014 Parnell Springmeyer
-- License     :  All Rights Reserved
-- Maintainer  :  Parnell Springmeyer <parnell@digitalmentat.com>
-- Stability   :  stable
--
-- Types and utility functions for representing parsed org-mode
-- documents.
----------------------------------------------------------------------------

{-# LANGUAGE OverloadedStrings #-}

module Data.OrgMode.Parse.Types
(
-- * Heading
  Heading  (..)
, Priority (..)
, toPriority
, State    (..)
, Keyword  (..)
-- * PropertyDrawer
, PropertyDrawer (..)
-- * Schedule & Timestamp
, Schedule     (..)
, ScheduleType (..)
, Timestamp    (..)
, Open         (..)
, Close        (..)
) where

import           Data.HashMap.Strict  (HashMap)
import           Data.Text            (Text)
import           Data.Thyme.LocalTime (LocalTime (..))

----------------------------------------------------------------------------
-- | An OrgMode heading.
data Heading = Heading
    { level    :: Int
    , priority :: Maybe Priority
    , state    :: Maybe State
    , title    :: Text
    , keywords :: [Keyword]
    } deriving (Show, Eq)

-- | The priority of a heading item.
--
-- `A`, `B`, and `C` correspond to the `[#A]`, `[#B]`, and `[#C]`
-- syntax in OrgMode document headings.
data Priority = A | B | C | Unknown
  deriving (Show, Read, Eq, Ord)

-- | The state of a heading (TODO, DONE, EVENT, etc...)
newtype State = State Text
  deriving (Show, Eq)

-- | A keyword in a heading *not part of the property drawer*!
newtype Keyword = Keyword Text
  deriving (Show, Eq, Ord)

-- | Convert text into a Priority value.
toPriority :: Text -> Priority
toPriority "A" = A
toPriority "B" = B
toPriority "C" = C
toPriority _   = Unknown

----------------------------------------------------------------------------
-- | The property drawer as an unordered HashMap.
newtype PropertyDrawer k v = PropertyDrawer (HashMap k v)
  deriving (Show, Eq)

----------------------------------------------------------------------------
-- | The "schedule" line. In OrgMode it must precede the heading
-- immediately and can contain a `SCHEDULED`, `DEADLINE`, or none. No
-- marker assumes the lonely timestamp is therefore an *appointment*.
--
-- *SCHEDULED* is the date & time you are going to start on something
-- and the appointment is the date and time something occurs.
--
-- Recurring time intervals are also possible and are not parsed right
-- now but are kept in the `recurring` field.
data Schedule = Schedule
    { schedule_type :: ScheduleType
    , timestamp     :: Maybe Timestamp
    , recurring     :: Maybe Text
    } deriving (Show, Eq)

-- | The schedule value, no value (or a failed parse) will result in
-- simply the APPOINTMENT value.
data ScheduleType = SCHEDULED | DEADLINE | APPOINTMENT
  deriving (Show, Eq)

-- | An active or inactive timestamp as `LocalTime`.
data Timestamp = Active LocalTime | Inactive LocalTime
  deriving (Show, Eq)

-- | So we don't get confused when passing the opening and closing
-- characters to the timestamp parser.
newtype Open = Open Char
newtype Close = Close Char