-- |
-- 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 " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
iD forall a. Semigroup a => a -> a -> a
<> String
" (" forall a. Semigroup a => a -> a -> a
<> String
rels' forall a. Semigroup a => a -> a -> a
<> String
")"
        where rels' :: String
rels' = forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => (a, RelationBits) -> String
showRel forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== RelationBits
allRelationBits = String
"??? " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
n
                             | Bool
otherwise = forall a b. (a -> b) -> [a] -> [b]
map Relation -> Char
relationToChar (RelationBits -> [Relation]
fromBits RelationBits
r) forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> 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 = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relation -> Relation -> Bool
$c/= :: Relation -> Relation -> Bool
== :: Relation -> Relation -> Bool
$c== :: Relation -> Relation -> Bool
Eq, Int -> Relation -> ShowS
[Relation] -> ShowS
Relation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relation] -> ShowS
$cshowList :: [Relation] -> ShowS
show :: Relation -> String
$cshow :: Relation -> String
showsPrec :: Int -> Relation -> ShowS
$cshowsPrec :: Int -> Relation -> ShowS
Show, Int -> Relation
Relation -> Int
Relation -> [Relation]
Relation -> Relation
Relation -> Relation -> [Relation]
Relation -> Relation -> Relation -> [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
enumFromThenTo :: Relation -> Relation -> Relation -> [Relation]
$cenumFromThenTo :: Relation -> Relation -> Relation -> [Relation]
enumFromTo :: Relation -> Relation -> [Relation]
$cenumFromTo :: Relation -> Relation -> [Relation]
enumFromThen :: Relation -> Relation -> [Relation]
$cenumFromThen :: Relation -> Relation -> [Relation]
enumFrom :: Relation -> [Relation]
$cenumFrom :: Relation -> [Relation]
fromEnum :: Relation -> Int
$cfromEnum :: Relation -> Int
toEnum :: Int -> Relation
$ctoEnum :: Int -> Relation
pred :: Relation -> Relation
$cpred :: Relation -> Relation
succ :: Relation -> Relation
$csucc :: Relation -> Relation
Enum, Relation
forall a. a -> a -> Bounded a
maxBound :: Relation
$cmaxBound :: Relation
minBound :: Relation
$cminBound :: 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  = [forall a. Bounded a => a
minBound..]

-- | Bit representation of all possible relations.
allRelationBits :: RelationBits
allRelationBits :: RelationBits
allRelationBits = [RelationBits] -> RelationBits
relationUnion forall a b. (a -> b) -> a -> b
$ 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 = forall a. Bits a => Int -> a
bit forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Bits a => a -> a -> a
.&. Relation -> RelationBits
toBits Relation
x forall a. Eq a => a -> a -> Bool
/= RelationBits
0]

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

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