-- |
-- Module      : Data.Allen.Types
-- Description : Types for Allen's interval algebra.
-- Maintainer  : Archaversine 
--
-- This module provides types that are used throughout the rest of the library.
-- This includes types for intervals, relations, and the interval graph.
--
-- = Intervals
-- An Interval is a data type that represents a single interval. It contains 
-- an ID of type 'IntervalID' and a map of relations to other intervals of type 
-- Map 'IntervalID' 'RelationBits'.
--
-- An `IntervalID` is essentially the same as an @Int@, but it is helpful to 
-- have a dedicated type synonym to distinguish functions that perform operations 
-- interval IDs.
--
-- = Relations
-- A 'Relation' is a data type that represents a relation between two intervals.
-- It is defined in terms of thirteen constructors, where each constructor 
-- represents one of the thirteen possible relations in Allen's interval algebra.
--
-- The 'RelationBits' is used to represent a set of possible representation.
-- It is synonymous with a @Word16@, and is used to represent a set of possible 
-- relations. Since there are only thirteen different relations, only 13 of the 
-- 16 bits in the @Word16@ are used.
--
-- = Interval Graph
-- An interval graph is a map of 'IntervalID's to 'Interval's. It is used to
-- represent the network of intervals and their relations to each other.
--
-- = Allen Monad
-- The Allen monad is a state monad that is used to keep track of the interval 
-- graph that is being built up during the computation. Since it is a synonym 
-- of the @State@ monad, it is possible to use all of the functions in the 
-- @Control.Monad.State@ module.

module Data.Allen.Types ( Interval(..)
                        , Allen
                        , IntervalID
                        , IntervalGraph
                        , Relation(..)
                        , RelationBits
                        , allRelations
                        , allRelationBits
                        , toBits
                        , fromBits
                        , relationUnion
                        , relationIntersection
                        , relationToChar
                        , fromID
                        ) where  

import Control.Monad.State

import Data.Bits
import Data.List (intercalate, foldl')
import Data.Word (Word16)

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

-- | How intervals are uniquely identified.
type IntervalID = Int

-- | This is the main type that is used to represent the network of intervals.
type IntervalGraph = Map IntervalID Interval

-- | An interval is a data type that represents a single interval. It contains 
-- an ID of type 'IntervalID' and a map of relations to other intervals of type 
-- Map 'IntervalID' 'RelationBits'. It should not be directly used in a  
-- computation unless the 'IntervalGraph' is in its final state.
data Interval = Interval { Interval -> Int
intervalID        :: Int 
                         , Interval -> Map Int RelationBits
intervalRelations :: Map IntervalID RelationBits
                         } 

-- | Ex: Interval 3 (d 1, D 2)
instance Show Interval where 
    show :: Interval -> String
show (Interval Int
iD Map Int RelationBits
rels) = String
"Interval " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
iD String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
rels' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
        where rels' :: String
rels' = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Int, RelationBits) -> String)
-> [(Int, RelationBits)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, RelationBits) -> String
forall {a}. Show a => (a, RelationBits) -> String
showRel ([(Int, RelationBits)] -> [String])
-> [(Int, RelationBits)] -> [String]
forall a b. (a -> b) -> a -> b
$ Map Int RelationBits -> [(Int, RelationBits)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int RelationBits
rels
              showRel :: (a, RelationBits) -> String
showRel (a
n, RelationBits
r) | RelationBits
r RelationBits -> RelationBits -> Bool
forall a. Eq a => a -> a -> Bool
== RelationBits
allRelationBits = String
"??? " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
n
                             | Bool
otherwise = (Relation -> Char) -> [Relation] -> String
forall a b. (a -> b) -> [a] -> [b]
map Relation -> Char
relationToChar (RelationBits -> [Relation]
fromBits RelationBits
r) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
n

-- | Return the interval given it's ID.
-- Panics if ID doesn't exist.
fromID :: IntervalID -> Allen Interval 
fromID :: Int -> Allen Interval
fromID Int
n = (Map Int Interval -> Interval) -> Allen Interval
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Map Int Interval -> Int -> Interval
forall k a. Ord k => Map k a -> k -> a
Map.! Int
n)

-- | A specific instance of the state monad that is used to keep track of the 
-- 'IntervalGraph' that is being built up during the computation.
type Allen = State IntervalGraph

-- | A type where each constructor represents one of the thirteen relations in 
-- Allen's interval algebra.
data Relation = Precedes      -- ^ In Char form: __p__
              | Meets         -- ^ In Char form: __m__ 
              | Overlaps      -- ^ In Char form: __o__ 
              | FinishedBy    -- ^ In Char form: __F__
              | Contains      -- ^ In Char form: __D__
              | Starts        -- ^ In Char form: __s__
              | Equals        -- ^ In Char form: __e__
              | StartedBy     -- ^ In Char form: __S__
              | During        -- ^ In Char form: __d__ 
              | Finishes      -- ^ In Char form: __f__
              | OverlappedBy  -- ^ In Char form: __O__ 
              | MetBy         -- ^ In Char form: __M__
              | PrecededBy    -- ^ In Char form: __P__
              deriving (Relation -> Relation -> Bool
(Relation -> Relation -> Bool)
-> (Relation -> Relation -> Bool) -> Eq Relation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
/= :: Relation -> Relation -> Bool
Eq, Int -> Relation -> ShowS
[Relation] -> ShowS
Relation -> String
(Int -> Relation -> ShowS)
-> (Relation -> String) -> ([Relation] -> ShowS) -> Show Relation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Relation -> ShowS
showsPrec :: Int -> Relation -> ShowS
$cshow :: Relation -> String
show :: Relation -> String
$cshowList :: [Relation] -> ShowS
showList :: [Relation] -> ShowS
Show, Int -> Relation
Relation -> Int
Relation -> [Relation]
Relation -> Relation
Relation -> Relation -> [Relation]
Relation -> Relation -> Relation -> [Relation]
(Relation -> Relation)
-> (Relation -> Relation)
-> (Int -> Relation)
-> (Relation -> Int)
-> (Relation -> [Relation])
-> (Relation -> Relation -> [Relation])
-> (Relation -> Relation -> [Relation])
-> (Relation -> Relation -> Relation -> [Relation])
-> Enum Relation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Relation -> Relation
succ :: Relation -> Relation
$cpred :: Relation -> Relation
pred :: Relation -> Relation
$ctoEnum :: Int -> Relation
toEnum :: Int -> Relation
$cfromEnum :: Relation -> Int
fromEnum :: Relation -> Int
$cenumFrom :: Relation -> [Relation]
enumFrom :: Relation -> [Relation]
$cenumFromThen :: Relation -> Relation -> [Relation]
enumFromThen :: Relation -> Relation -> [Relation]
$cenumFromTo :: Relation -> Relation -> [Relation]
enumFromTo :: Relation -> Relation -> [Relation]
$cenumFromThenTo :: Relation -> Relation -> Relation -> [Relation]
enumFromThenTo :: Relation -> Relation -> Relation -> [Relation]
Enum, Relation
Relation -> Relation -> Bounded Relation
forall a. a -> a -> Bounded a
$cminBound :: Relation
minBound :: Relation
$cmaxBound :: Relation
maxBound :: Relation
Bounded)

-- | Convert a relation to its Char representation.
relationToChar :: Relation -> Char 
relationToChar :: Relation -> Char
relationToChar Relation
r = case Relation
r of 
    Relation
Precedes     -> Char
'p'
    Relation
Meets        -> Char
'm'
    Relation
Overlaps     -> Char
'o'
    Relation
FinishedBy   -> Char
'F'
    Relation
Contains     -> Char
'D'
    Relation
Starts       -> Char
's'
    Relation
Equals       -> Char
'e'
    Relation
StartedBy    -> Char
'S'
    Relation
During       -> Char
'd'
    Relation
Finishes     -> Char
'f'
    Relation
OverlappedBy -> Char
'O'
    Relation
MetBy        -> Char
'M'
    Relation
PrecededBy   -> Char
'P'

-- | A bit representation that acts as a set of possible relations between 
-- intervals.
type RelationBits = Word16

-- | List of all possible relations.
allRelations :: [Relation]
allRelations :: [Relation]
allRelations  = [Relation
forall a. Bounded a => a
minBound..]

-- | Bit representation of all possible relations.
allRelationBits :: RelationBits
allRelationBits :: RelationBits
allRelationBits = [RelationBits] -> RelationBits
relationUnion ([RelationBits] -> RelationBits) -> [RelationBits] -> RelationBits
forall a b. (a -> b) -> a -> b
$ (Relation -> RelationBits) -> [Relation] -> [RelationBits]
forall a b. (a -> b) -> [a] -> [b]
map Relation -> RelationBits
toBits [Relation]
allRelations

-- | Convert a Relation type to its bit representation.
toBits :: Relation -> RelationBits
toBits :: Relation -> RelationBits
toBits = Int -> RelationBits
forall a. Bits a => Int -> a
bit (Int -> RelationBits)
-> (Relation -> Int) -> Relation -> RelationBits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation -> Int
forall a. Enum a => a -> Int
fromEnum

-- | Convert a bit representation to a list of Relation types.
fromBits :: RelationBits -> [Relation]
fromBits :: RelationBits -> [Relation]
fromBits RelationBits
bits = [Relation
x | Relation
x <- [Relation]
allRelations, RelationBits
bits RelationBits -> RelationBits -> RelationBits
forall a. Bits a => a -> a -> a
.&. Relation -> RelationBits
toBits Relation
x RelationBits -> RelationBits -> Bool
forall a. Eq a => a -> a -> Bool
/= RelationBits
0]

-- | Calculate the union of a list of relations.
relationUnion :: [RelationBits] -> RelationBits
relationUnion :: [RelationBits] -> RelationBits
relationUnion = (RelationBits -> RelationBits -> RelationBits)
-> RelationBits -> [RelationBits] -> RelationBits
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' RelationBits -> RelationBits -> RelationBits
forall a. Bits a => a -> a -> a
(.|.) RelationBits
0

-- | Calculate the intersection of a list of relations.
relationIntersection :: [RelationBits] -> RelationBits 
relationIntersection :: [RelationBits] -> RelationBits
relationIntersection = (RelationBits -> RelationBits -> RelationBits)
-> RelationBits -> [RelationBits] -> RelationBits
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' RelationBits -> RelationBits -> RelationBits
forall a. Bits a => a -> a -> a
(.&.) RelationBits
0