packages feed

time-patterns 0.1.1.0 → 0.1.2.0

raw patch · 3 files changed

+140/−97 lines, 3 filesdep +profunctors

Dependencies added: profunctors

Files

src/Data/Time/Patterns.hs view
@@ -6,7 +6,7 @@ -- License     :  BSD3 (see the file LICENSE) -- Maintainer  :  j.mueller.11@ucl.ac.uk -- Stability   :  experimental--- Patterns for re-occurring events. Use the @DatePattern@ type to build up+-- Patterns for recurring events. Use the @DatePattern@ type to build up -- a pattern, and the functions @elementOf@, @instancesFrom@ and  -- @intervalsFrom@ to evaluate it. -- Simple example:@@ -27,7 +27,7 @@ -- obvious meanings and @inEach@ which repeats one pattern inside another one. -- For example,  ----- > ((take 1 day) 'inEach' august) `intersect` sunday+-- > ((take 1 day) `inEach` august) `intersect` sunday -- -- will give the 1st of August in years when it falls on a Sunday. ----------------------------------------------------------------------------@@ -87,7 +87,7 @@ import qualified Prelude as P  -- | A DatePattern describes a sequence of intervals of type Data.Thyme.Day.-type DatePattern = IntervalSequence Day+type DatePattern = IntervalSequence' Day  -- | An event that occurs every month. month :: DatePattern@@ -213,7 +213,7 @@  -- | Shift all the results by a number of day shiftBy :: Days -> DatePattern -> DatePattern-shiftBy n sq = mapS (addDays n) sq+shiftBy n = fmap (addDays n)  -- | Add a number of day to a day addDays :: Days -> Day -> Day
src/Data/Time/Patterns/Internal.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Time.Patterns.Internal@@ -8,30 +10,126 @@ -- Stability   :  experimental -- Internal stuff for time patterns -----------------------------------------------------------------------------module Data.Time.Patterns.Internal where+module Data.Time.Patterns.Internal(+    -- * Types+    IntervalSequence(..),+    IntervalSequence',+    -- * General combinators+    never,+    union,+    diag,+    take,+    cycle,+    stopAt,+    stopAt',+    before,+    andThen,+    -- * Combinators for IntervalSequence'+    every,+    filter,+    elementOf,+    occurrencesFrom,+    elementsFrom,+    skip,+    skipUntil,+    except,+    except',+    firstOccurrenceIn,+    intersect,+    -- * Other+    elements+    ) where  import Numeric.Interval import Data.Monoid (Monoid(..))-import Data.Thyme.Clock (UTCTime)+import Data.Profunctor (Profunctor(..)) import Prelude hiding (cycle, elem, filter, take) --- | If the argument to nextOccurrence is part of an interval, then the result should be the interval containing it.--- The interval should be closed at the first parameter and open at the second, so that repeated calls of--- nextOccurrence yield a sequence of occurrences.-newtype IntervalSequence t = IntervalSequence { nextInterval :: t -> Maybe (Interval t, IntervalSequence t)}+-- | A sequence of intervals, starting from a point.+-- If the argument to @nextInterval@ is part of an interval, then the result +-- should be the interval containing it.+newtype IntervalSequence t s = IntervalSequence { nextInterval :: t -> Maybe (Interval s, IntervalSequence t s)} -type TimePattern = IntervalSequence UTCTime -- TimePattern should cycle throu+-- | IntervalSequences that can be evaluated repeatedly.+type IntervalSequence' t = IntervalSequence t t -instance (Ord t) => Monoid (IntervalSequence t) where+instance (Ord s) => Monoid (IntervalSequence t s) where     mappend = union     mempty  = never +instance Functor (IntervalSequence t) where+    fmap f s = IntervalSequence $ \d -> nextInterval s d >>= \r -> return (fmap f $ fst r, fmap f $ snd r)++instance Profunctor IntervalSequence where+    rmap = fmap+    lmap f s = IntervalSequence $ \d -> (nextInterval s $ f d) >>= \r -> return (fst r, lmap f $ snd r)+ -- | A sequence with no occurrences-never :: IntervalSequence t+never :: IntervalSequence t s never = IntervalSequence $ const $ Nothing +-- | Occurrences from both intervals. +--   The difference between @union@ and @diag@ is that @union@ preserves+--   the order of the results+union :: Ord s => IntervalSequence t s -> IntervalSequence t s -> IntervalSequence t s+union a b = IntervalSequence $ \d ->+    case (nextInterval a d, nextInterval b d) of+        (Nothing, Nothing) -> Nothing+        (Nothing, b')       -> b'+        (a',       Nothing) -> a'+        (Just (ia, sa), Just (ib, sb)) -> +            case (sup ia <= sup ib) of+                True -> return (ia, union sa (ib `andThen` sb))+                False -> return (ib, union (ia `andThen` sa) sb)+++-- | Merge two sequences into one by switching between them+diag :: IntervalSequence t s -> IntervalSequence t s -> IntervalSequence t s+diag a b = IntervalSequence (nOcc' a b) where+    nOcc' a' b' d = do+        (na, sa) <- nextInterval a' d+        return (na, diag b' sa)++-- | End a sequence after n occurrences+take :: Int -> IntervalSequence t s -> IntervalSequence t s+take n IntervalSequence{..} +    | n < 1     = never+    | otherwise = IntervalSequence $ \d -> +        nextInterval d >>= \r -> Just (fst r, take (pred n) $ snd r)++-- | Repeat a point infinitely+cycle :: Interval s -> IntervalSequence t s+cycle i = IntervalSequence $ const $ Just (i, cycle i)++-- | Take occurrences until an interval containing the argument is reached+stopAt :: Ord s => Interval s -> IntervalSequence t s -> IntervalSequence t s+stopAt p IntervalSequence{..} = IntervalSequence ni' where+    ni' d = nextInterval d >>= \(p', q) -> case (p' `contains` p) of+        True -> Nothing+        False -> return (p', stopAt p q)++-- | Take occurrences until an interval whose supremum is greater than the+-- argument is reached.+stopAt' :: Ord s => s -> IntervalSequence t s -> IntervalSequence t s+stopAt' p IntervalSequence{..} = IntervalSequence ni' where+    ni' d = nextInterval d >>= \(p', q) -> case (sup p' >= p) of+        True -> Nothing+        False -> return (p', stopAt' p q)++-- | Stop as soon as a result greater than or equal to the parameter+--   is produced+before :: Ord s => Interval s -> IntervalSequence t s -> IntervalSequence t s+before p IntervalSequence{..} = IntervalSequence ni' where+    ni' d = nextInterval d >>= \(p', q) -> case (p >=! p') of+        False -> Nothing+        True  -> return (p', stopAt p q)++-- | Prepend an interval to an interval sequence+andThen :: Interval s -> IntervalSequence t s -> IntervalSequence t s+andThen i sq = IntervalSequence $ \_ -> Just (i, sq)+ -- | Take every nth occurrence-every :: Int -> IntervalSequence t -> IntervalSequence t+every :: Int -> IntervalSequence' t -> IntervalSequence' t every n sq@IntervalSequence{..}    | n < 1 = never   | otherwise = IntervalSequence $ nextOcc 1@@ -41,44 +139,29 @@             | otherwise = nextInterval d >>= nextOcc (n' + 1) . sup . fst  -- | Accept results which satisfy a condition-filter :: (Interval t -> Bool) -> IntervalSequence t -> IntervalSequence t+filter :: (Interval t -> Bool) -> IntervalSequence' t -> IntervalSequence' t filter f IntervalSequence{..} = IntervalSequence nOcc' where     nOcc' t = nextInterval t >>= checkCondition     checkCondition (p,q) = case (f p) of         True -> Just (p, filter f q)         False -> nOcc' $ sup p ---- | Repeat a point infinitely-cycle :: Interval t -> IntervalSequence t-cycle i = IntervalSequence $ const $ Just (i, cycle i)- -- | Check if a point is covered by an interval sequence-elementOf :: Ord t => t -> IntervalSequence t -> Bool+elementOf :: Ord t => t -> IntervalSequence' t -> Bool elementOf t IntervalSequence{..} = maybe False (\(p,_) -> (elem t p) && (<) t (sup p)) (nextInterval t)  -- | The sequence of occurrences from an initial point.-occurrencesFrom :: t -> IntervalSequence t -> [Interval t]+occurrencesFrom :: t -> IntervalSequence' t -> [Interval t] occurrencesFrom start IntervalSequence{..} = case (nextInterval start) of     Nothing -> []     Just (res, sq') -> res : occurrencesFrom (sup res) sq'  -- | Elements covered by an interval sequence from an initial point.-elementsFrom :: Enum t => t -> IntervalSequence t -> [t]+elementsFrom :: Enum t => t -> IntervalSequence' t -> [t] elementsFrom start sq = concat $ fmap elements $ occurrencesFrom start sq -elements :: Enum a => Interval a -> [a]-elements i = enumFromTo (inf i) (pred $ sup i)---- | End a sequence after n occurrences-take :: Int -> IntervalSequence t -> IntervalSequence t-take n IntervalSequence{..} -    | n < 1     = never-    | otherwise = IntervalSequence $ \d -> -        nextInterval d >>= \r -> Just (fst r, take (pred n) $ snd r)- -- | Skip the first n occurrences of a sequence-skip :: Int -> IntervalSequence t -> IntervalSequence t+skip :: Int -> IntervalSequence' t -> IntervalSequence' t skip n sq   | n < 0 = never   | otherwise = IntervalSequence $ nextOcc (nextInterval sq) n@@ -87,51 +170,31 @@             | n' < 1 = ni d              | otherwise = ni d >>= \(p, q) -> nextOcc (nextInterval q) (n' - 1) (sup p) --- | Take occurrences until an interval is reached-stopAt :: Ord t => Interval t -> IntervalSequence t -> IntervalSequence t-stopAt p IntervalSequence{..} = IntervalSequence ni' where-    ni' d = nextInterval d >>= \(p', q) -> case (p' `contains` p) of-        True -> Nothing-        False -> return (p', stopAt p q)--stopAt' :: Ord t => t -> IntervalSequence t -> IntervalSequence t-stopAt' p IntervalSequence{..} = IntervalSequence ni' where-    ni' d = nextInterval d >>= \(p', q) -> case (sup p' >= p) of-        True -> Nothing-        False -> return (p', stopAt' p q)---- | Stop as soon as a result greater than or equal to the parameter---   is produced-before :: Ord t => Interval t -> IntervalSequence t -> IntervalSequence t-before p IntervalSequence{..} = IntervalSequence ni' where-    ni' d = nextInterval d >>= \(p', q) -> case (p >=! p') of-        False -> Nothing-        True  -> return (p', stopAt p q)--skipUntil :: Ord t => Interval t -> IntervalSequence t -> IntervalSequence t-skipUntil fr sq = IntervalSequence $ nextOcc $ nextInterval sq where-    nextOcc ni d = ni d >>= \(p', q) -> case (fr <=! p') of-        False -> nextOcc (nextInterval q) (sup p')-        True  -> return (p', q)+-- | Skip intervals until the infimum of the argument is reached.+--+-- If the intervals in the sequence are not ordered, then this function might+-- not terminate.+skipUntil :: Ord t => Interval t -> IntervalSequence' t -> IntervalSequence' t+skipUntil = stopAt' . inf  -- | Skip over a point in the sequence. All occurrences of this --   datum are removed.-except :: (Enum t, Ord t) => t -> IntervalSequence t -> IntervalSequence t+except :: (Enum t, Ord t) => t -> IntervalSequence' t -> IntervalSequence' t except p = except' (p ... succ p)  -- | Skip over all intervals which contain the parameter-except' ::Ord t => Interval t -> IntervalSequence t -> IntervalSequence t+except' :: Ord t => Interval t -> IntervalSequence' t -> IntervalSequence' t except' p IntervalSequence{..} = IntervalSequence ni' where     ni' d = nextInterval d >>= \(p', q) -> case (p' `contains` p) of         False -> return (p', except' p q)          True -> ni' $ sup p --- | Apply a function to the results of an interval sequence-mapS :: (t -> t) -> IntervalSequence t -> IntervalSequence t-mapS f IntervalSequence{..} = IntervalSequence nOcc' where-    nOcc' d = nextInterval d >>= \r -> return (fmap f $ fst r, snd r)--firstOccurrenceIn :: (Enum t, Ord t) => t -> Interval t -> IntervalSequence t -> Maybe (Interval t, IntervalSequence t)+-- | Search for the first result within the specified interval, starting from+-- a point. +--+-- If the intervals in the sequence are not ordered, then this function might+-- not terminate.+firstOccurrenceIn :: (Enum t, Ord t) => t -> Interval t -> IntervalSequence' t -> Maybe (Interval t, IntervalSequence' t) firstOccurrenceIn s i IntervalSequence{..} = firstOcc s where     firstOcc start = do         (p, q) <- nextInterval start@@ -142,7 +205,7 @@                 False -> Nothing  -- | Return intervals that are exactly the same-intersect :: (Ord t, Enum t) => IntervalSequence t -> IntervalSequence t -> IntervalSequence t+intersect :: (Ord t, Enum t) => IntervalSequence' t -> IntervalSequence' t -> IntervalSequence' t intersect a b = IntervalSequence (nOcc' a b) where     nOcc' a' b' d = do         (ia, sa) <- nextInterval a' d@@ -151,26 +214,5 @@             True -> return (ib, intersect sa sb)             False -> nOcc' b' sa $ sup ia -- mix up a' and b' to search in both directions evenly --- | Merge two sequences into one by switching between them-diag :: IntervalSequence t -> IntervalSequence t -> IntervalSequence t-diag a b = IntervalSequence (nOcc' a b) where-    nOcc' a' b' d = do-        (na, sa) <- nextInterval a' d-        return (na, diag b' sa)---- | Occurrences from both intervals.-union :: Ord t => IntervalSequence t -> IntervalSequence t -> IntervalSequence t-union a b = IntervalSequence $ \d ->-    case (nextInterval a d, nextInterval b d) of-        (Nothing, Nothing) -> Nothing-        (Nothing, b')       -> b'-        (a',       Nothing) -> a'-        (Just (ia, sa), Just (ib, sb)) -> -            case (sup ia <= sup ib) of-                True -> return (ia, union sa (ib `andThen` sb))-                False -> return (ib, union (ia `andThen` sa) sb)---- | Prepend an interval to an interval sequence-andThen :: Interval t -> IntervalSequence t -> IntervalSequence t-andThen i sq = IntervalSequence $ \_ -> Just (i, sq)-+elements :: Enum a => Interval a -> [a]+elements i = enumFromTo (inf i) (pred $ sup i)
time-patterns.cabal view
@@ -2,8 +2,8 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                time-patterns-version:             0.1.1.0-synopsis:            Patterns of re-occurring events    +version:             0.1.2.0+synopsis:            Patterns of reccurring events     license:             BSD3 license-file:        LICENSE author:              Jann Müller@@ -14,7 +14,7 @@ cabal-version:       >= 1.10 homepage:            https://bitbucket.org/jfmueller/time-patterns bug-reports:         https://bitbucket.org/jfmueller/time-patterns/issues-synopsis:            Patterns for re-occurring events.+synopsis:            Patterns for reccurring events. description:            This package contains a set of primitives and combinators for event patterns. Example:   .@@ -30,11 +30,12 @@   location: git@bitbucket.org:jfmueller/time-patterns.git  library-  exposed-modules:     Data.Time.Patterns-  other-modules:       Data.Time.Patterns.Internal+  exposed-modules:     Data.Time.Patterns,+                       Data.Time.Patterns.Internal   build-depends:       base >=4.6 && <4.7,                        intervals == 0.4,                        lens >= 3.9,+                       profunctors >= 4,                        thyme == 0.3.*,                        vector-space == 0.8.6   hs-source-dirs:      src