Skip to content

Add Interval #52

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 34 commits into from
Jun 26, 2017
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
34 commits
Select commit Hold shift + click to select a range
593e364
WIP: Add Interval
safareli Apr 3, 2017
37b6f36
remove unused imports
safareli Apr 3, 2017
fac9d4b
remove dublicats
safareli Apr 3, 2017
0805ce4
update Duration
safareli Apr 4, 2017
5c49ea6
add couple instances for Duration and Interval
safareli Apr 4, 2017
d7dec5a
reorder code
safareli Apr 4, 2017
62bf305
remove mkDuration DurationView and Milliseconds component
safareli Apr 5, 2017
089d9ef
fis ord instance of DurationComponent
safareli Apr 5, 2017
266d481
make Interval Bifunctor
safareli Apr 6, 2017
0a7b628
add Bifoldable for Interval
safareli Apr 6, 2017
0ceb8eb
add IsoDuration; use Map instead of List Tuple
safareli Apr 6, 2017
c6cbe32
derive instances for RecurringInterval
safareli Apr 18, 2017
42bbfb7
Merge branch 'master' into interval
safareli Apr 18, 2017
503c6f8
fix derivations
safareli Apr 18, 2017
5d06e53
add Bitraversable and Eq instances
safareli Apr 19, 2017
d2acbd6
export Duration and DurationComponent
safareli Apr 25, 2017
5f66a89
make sure IsoDuraiton is not empty
safareli Apr 26, 2017
ea6396c
add ^ to PS version
safareli Apr 26, 2017
e95b67f
revert travis changes
safareli Apr 27, 2017
34640c6
make Duration new type and derive Newype
safareli May 16, 2017
809a234
make duration components singular
safareli May 16, 2017
3eda0dd
reverse duration component order
safareli May 16, 2017
720cab7
make isoDuration newtype
safareli Jun 6, 2017
5e7b7be
allow only positive values in duration
safareli Jun 6, 2017
fbd30c4
remove some TODOs
safareli Jun 23, 2017
359e28a
fix spaces and unicodes
safareli Jun 23, 2017
355eb63
add ord instances
safareli Jun 23, 2017
dfca687
fix spacing, parens and $ usage
safareli Jun 23, 2017
c3817cc
rename JustDuration to DurationOnly
safareli Jun 23, 2017
d9457d2
split Interval
safareli Jun 23, 2017
447406a
reverse DurationComponent order
safareli Jun 23, 2017
d829b8c
add Week component to Duration; refactor Duration.Iso
safareli Jun 23, 2017
08c4d82
move checkWeekUsage up add tests
safareli Jun 23, 2017
84d8b2c
use NonEmptyList instead of NonEmpty Array; add prettyError
safareli Jun 23, 2017
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ script:
- bower install --production
- npm run -s build
- bower install
- npm test
- npm run -s test
after_success:
- >-
test $TRAVIS_TAG &&
Expand Down
5 changes: 3 additions & 2 deletions bower.json
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,9 @@
"purescript-functions": "^3.0.0",
"purescript-generics": "^4.0.0",
"purescript-integers": "^3.0.0",
"purescript-math": "^2.0.0",
"purescript-foldable-traversable": "^3.0.0"
"purescript-foldable-traversable": "^3.0.0",
"purescript-maps": "^3.0.0",
"purescript-math": "^2.0.0"
},
"devDependencies": {
"purescript-assert": "^3.0.0",
Expand Down
4 changes: 2 additions & 2 deletions package.json
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,8 @@
},
"devDependencies": {
"eslint": "^3.17.1",
"pulp": "^10.0.4",
"purescript-psa": "^0.5.0-rc.1",
"pulp": "^11.0.x",
"purescript-psa": "^0.5.x",
"rimraf": "^2.6.1"
}
}
115 changes: 115 additions & 0 deletions src/Data/Interval.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,115 @@
module Data.Interval
( Interval(..)
, RecurringInterval(..)
, module DurationExports
) where

import Prelude

import Control.Extend (class Extend, extend)
import Data.Bifoldable (class Bifoldable, bifoldl, bifoldr, bifoldrDefault, bifoldMapDefaultL)
import Data.Bifunctor (class Bifunctor, bimap)
import Data.Bitraversable (class Bitraversable, bitraverse, bisequenceDefault)
import Data.Foldable (class Foldable, foldl, foldr, foldrDefault, foldMapDefaultL)
import Data.Interval.Duration as DurationExports
import Data.Maybe (Maybe)
import Data.Traversable (class Traversable, traverse, sequenceDefault)

data RecurringInterval d a = RecurringInterval (Maybe Int) (Interval d a)

derive instance eqRecurringInterval :: (Eq d, Eq a) => Eq (RecurringInterval d a)
derive instance ordRecurringInterval :: (Ord d, Ord a) => Ord (RecurringInterval d a)
instance showRecurringInterval :: (Show d, Show a) => Show (RecurringInterval d a) where
show (RecurringInterval x y) = "(RecurringInterval " <> show x <> " " <> show y <> ")"

interval :: ∀ d a. RecurringInterval d a -> Interval d a
interval (RecurringInterval _ i) = i

over :: ∀ f d a d' a'. Functor f => (Interval d a -> f (Interval d' a')) -> RecurringInterval d a -> f (RecurringInterval d' a')
over f (RecurringInterval n i) = map (RecurringInterval n) (f i)

instance functorRecurringInterval :: Functor (RecurringInterval d) where
map f (RecurringInterval n i) = RecurringInterval n (map f i)

instance bifunctorRecurringInterval :: Bifunctor RecurringInterval where
bimap f g (RecurringInterval n i) = RecurringInterval n (bimap f g i)

instance foldableRecurringInterval :: Foldable (RecurringInterval d) where
foldl f i = foldl f i <<< interval
foldr f i = foldr f i <<< interval
foldMap = foldMapDefaultL

instance bifoldableRecurringInterval :: Bifoldable RecurringInterval where
bifoldl f g i = bifoldl f g i <<< interval
bifoldr f g i = bifoldr f g i <<< interval
bifoldMap = bifoldMapDefaultL

instance traversableRecurringInterval :: Traversable (RecurringInterval d) where
traverse f i = traverse f `over` i
sequence = sequenceDefault

instance bitraversableRecurringInterval :: Bitraversable RecurringInterval where
bitraverse l r i = bitraverse l r `over` i
bisequence = bisequenceDefault

instance extendRecurringInterval :: Extend (RecurringInterval d) where
extend f a@(RecurringInterval n i) = RecurringInterval n (extend (const (f a)) i)

data Interval d a
= StartEnd a a
| DurationEnd d a
| StartDuration a d
| DurationOnly d

derive instance eqInterval :: (Eq d, Eq a) => Eq (Interval d a)
derive instance ordInterval :: (Ord d, Ord a) => Ord (Interval d a)
instance showInterval :: (Show d, Show a) => Show (Interval d a) where
show (StartEnd x y) = "(StartEnd " <> show x <> " " <> show y <> ")"
show (DurationEnd d x) = "(DurationEnd " <> show d <> " " <> show x <> ")"
show (StartDuration x d) = "(StartDuration " <> show x <> " " <> show d <> ")"
show (DurationOnly d) = "(DurationOnly " <> show d <> ")"

instance functorInterval :: Functor (Interval d) where
map = bimap id

instance bifunctorInterval :: Bifunctor Interval where
bimap _ f (StartEnd x y) = StartEnd (f x) (f y)
bimap g f (DurationEnd d x) = DurationEnd (g d) (f x)
bimap g f (StartDuration x d) = StartDuration (f x) (g d)
bimap g _ (DurationOnly d) = DurationOnly (g d)

instance foldableInterval :: Foldable (Interval d) where
foldl f z (StartEnd x y) = (z `f` x) `f` y
foldl f z (DurationEnd d x) = z `f` x
foldl f z (StartDuration x d) = z `f` x
foldl _ z _ = z
foldr x = foldrDefault x
foldMap = foldMapDefaultL

instance bifoldableInterval :: Bifoldable Interval where
bifoldl _ f z (StartEnd x y) = (z `f` x) `f` y
bifoldl g f z (DurationEnd d x) = (z `g` d) `f` x
bifoldl g f z (StartDuration x d) = (z `g` d) `f` x
bifoldl g _ z (DurationOnly d) = z `g` d
bifoldr x = bifoldrDefault x
bifoldMap = bifoldMapDefaultL

instance traversableInterval :: Traversable (Interval d) where
traverse f (StartEnd x y) = StartEnd <$> f x <*> f y
traverse f (DurationEnd d x) = f x <#> DurationEnd d
traverse f (StartDuration x d) = f x <#> (_ `StartDuration` d)
traverse _ (DurationOnly d) = pure (DurationOnly d)
sequence = sequenceDefault

instance bitraversableInterval :: Bitraversable Interval where
bitraverse _ r (StartEnd x y) = StartEnd <$> r x <*> r y
bitraverse l r (DurationEnd d x) = DurationEnd <$> l d <*> r x
bitraverse l r (StartDuration x d) = StartDuration <$> r x <*> l d
bitraverse l _ (DurationOnly d) = DurationOnly <$> l d
bisequence = bisequenceDefault

instance extendInterval :: Extend (Interval d) where
extend f a@(StartEnd x y) = StartEnd (f a) (f a)
extend f a@(DurationEnd d x) = DurationEnd d (f a)
extend f a@(StartDuration x d) = StartDuration (f a) d
extend f (DurationOnly d) = DurationOnly d
74 changes: 74 additions & 0 deletions src/Data/Interval/Duration.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,74 @@
module Data.Interval.Duration
( Duration(..)
, DurationComponent(..)
, year
, month
, week
, day
, hour
, minute
, second
, millisecond
) where

import Prelude

import Data.Map as Map
import Data.Monoid (class Monoid, mempty)
import Data.Newtype (class Newtype)

newtype Duration = Duration (Map.Map DurationComponent Number)

derive instance eqDuration :: Eq Duration
derive instance ordDuration :: Ord Duration
derive instance newtypeDuration :: Newtype Duration _

instance showDuration :: Show Duration where
show (Duration d) = "(Duration " <> show d <> ")"

instance semigroupDuration :: Semigroup Duration where
append (Duration a) (Duration b) = Duration (Map.unionWith (+) a b)

instance monoidDuration :: Monoid Duration where
mempty = Duration mempty

data DurationComponent = Second | Minute | Hour | Day | Week | Month | Year
derive instance eqDurationComponent :: Eq DurationComponent
derive instance ordDurationComponent :: Ord DurationComponent

instance showDurationComponent :: Show DurationComponent where
show Minute = "Minute"
show Second = "Second"
show Hour = "Hour"
show Day = "Day"
show Week = "Week"
show Month = "Month"
show Year = "Year"


week :: Number -> Duration
week = durationFromComponent Week

year :: Number -> Duration
year = durationFromComponent Year

month :: Number -> Duration
month = durationFromComponent Month

day :: Number -> Duration
day = durationFromComponent Day

hour :: Number -> Duration
hour = durationFromComponent Hour

minute :: Number -> Duration
minute = durationFromComponent Minute

second :: Number -> Duration
second = durationFromComponent Second

millisecond :: Number -> Duration
millisecond = durationFromComponent Second <<< (_ / 1000.0)

durationFromComponent :: DurationComponent -> Number -> Duration
durationFromComponent k v = Duration (Map.singleton k v)
97 changes: 97 additions & 0 deletions src/Data/Interval/Duration/Iso.purs
Original file line number Diff line number Diff line change
@@ -0,0 +1,97 @@
module Data.Interval.Duration.Iso
( IsoDuration
, unIsoDuration
, mkIsoDuration
, Error(..)
, Errors
, prettyError
) where

import Prelude

import Control.Plus (empty)
import Data.Either (Either(..))
import Data.Foldable (fold, foldMap)
import Data.Interval.Duration (Duration(..), DurationComponent(..))
import Data.List (List(..), reverse, span, null)
import Data.List.NonEmpty (fromList)
import Data.List.Types (NonEmptyList)
import Data.Map as Map
import Data.Maybe (Maybe(..), isJust)
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..), snd)
import Math as Math

newtype IsoDuration = IsoDuration Duration

derive instance eqIsoDuration :: Eq IsoDuration
derive instance ordIsoDuration :: Ord IsoDuration
instance showIsoDuration :: Show IsoDuration where
show (IsoDuration d) = "(IsoDuration " <> show d <> ")"

type Errors = NonEmptyList Error

data Error
= IsEmpty
| InvalidWeekComponentUsage
| ContainsNegativeValue DurationComponent
| InvalidFractionalUse DurationComponent

derive instance eqError :: Eq Error
derive instance ordError :: Ord Error
instance showError :: Show Error where
show (IsEmpty) = "(IsEmpty)"
show (InvalidWeekComponentUsage) = "(InvalidWeekComponentUsage)"
show (ContainsNegativeValue c) = "(ContainsNegativeValue " <> show c <> ")"
show (InvalidFractionalUse c) = "(InvalidFractionalUse " <> show c <> ")"

prettyError :: Error -> String
prettyError (IsEmpty) = "Duration is empty (has no components)"
prettyError (InvalidWeekComponentUsage) = "Week component of Duration is used with other components"
prettyError (ContainsNegativeValue c) = "Component `" <> show c <> "` contains negative value"
prettyError (InvalidFractionalUse c) = "Invalid usage of Fractional value at component `" <> show c <> "`"


unIsoDuration :: IsoDuration -> Duration
unIsoDuration (IsoDuration a) = a

mkIsoDuration :: Duration -> Either Errors IsoDuration
mkIsoDuration d = case fromList (checkValidIsoDuration d) of
Just errs -> Left errs
Nothing -> Right (IsoDuration d)

checkValidIsoDuration :: Duration -> List Error
checkValidIsoDuration (Duration asMap) = check {asList, asMap}
where
asList = reverse (Map.toAscUnfoldable asMap)
check = fold
[ checkWeekUsage
, checkEmptiness
, checkFractionalUse
, checkNegativeValues
]


type CheckEnv =
{ asList :: List (Tuple DurationComponent Number)
, asMap :: Map.Map DurationComponent Number}

checkWeekUsage :: CheckEnv -> List Error
checkWeekUsage {asMap} = if isJust (Map.lookup Week asMap) && Map.size asMap > 1
then pure InvalidWeekComponentUsage else empty

checkEmptiness :: CheckEnv -> List Error
checkEmptiness {asList} = if null asList then pure IsEmpty else empty

checkFractionalUse :: CheckEnv -> List Error
checkFractionalUse {asList} = case _.rest (span (snd >>> not isFractional) asList) of
Cons (Tuple c _) rest | checkRest rest -> pure (InvalidFractionalUse c)
_ -> empty
where
isFractional a = Math.floor a /= a
checkRest rest = unwrap (foldMap (snd >>> Math.abs >>> Additive) rest) > 0.0

checkNegativeValues :: CheckEnv -> List Error
checkNegativeValues {asList} = flip foldMap asList \(Tuple c num) ->
if num >= 0.0 then empty else pure (ContainsNegativeValue c)
39 changes: 28 additions & 11 deletions test/Test/Main.purs
Original file line number Diff line number Diff line change
Expand Up @@ -4,32 +4,49 @@ import Prelude

import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)

import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, succ, fromEnum, pred)
import Data.Date as Date
import Data.Time as Time
import Data.Time.Duration as Duration
import Data.Array as Array
import Data.Date as Date
import Data.DateTime as DateTime
import Data.DateTime.Locale as Locale
import Data.DateTime.Instant as Instant
import Data.DateTime.Locale as Locale
import Data.Either (Either(..), isRight)
import Data.Enum (class BoundedEnum, Cardinality, toEnum, enumFromTo, cardinality, succ, fromEnum, pred)
import Data.Foldable (foldl, foldr, foldMap)
import Data.Interval as Interval
import Data.Interval.Duration.Iso as IsoDuration
import Data.Maybe (Maybe(..), fromJust)
import Data.Monoid (mempty)
import Data.Newtype (over, unwrap)
import Data.String (length)
import Data.Time as Time
import Data.Time.Duration as Duration
import Data.Traversable (sequence, traverse)
import Data.Tuple (Tuple(..), snd)
import Data.Newtype (over, unwrap)

import Math (floor)

import Type.Proxy (Proxy(..))
import Test.Assert (ASSERT, assert)
import Partial.Unsafe (unsafePartial)
import Test.Assert (ASSERT, assert)
import Type.Proxy (Proxy(..))

type Tests = Eff (console :: CONSOLE, assert :: ASSERT) Unit

main :: Tests
main = do
log "check Duration monoid"
assert $ Interval.year 1.0 == mempty <> Interval.year 2.0 <> Interval.year 1.0 <> Interval.year (-2.0)
assert $ Interval.second 0.5 == Interval.millisecond 500.0
assert $ IsoDuration.mkIsoDuration (Interval.week 1.2 <> Interval.week 1.2)
== IsoDuration.mkIsoDuration (Interval.week 2.4)
assert $ isRight $ IsoDuration.mkIsoDuration (Interval.day 1.2 <> mempty)
assert $ isRight $ IsoDuration.mkIsoDuration (Interval.day 1.2 <> Interval.second 0.0)
assert $ isRight $ IsoDuration.mkIsoDuration (Interval.year 2.0 <> Interval.day 1.0)
assert $ IsoDuration.mkIsoDuration (Interval.year 2.5 <> Interval.day 1.0)
== Left (pure (IsoDuration.InvalidFractionalUse Interval.Year))
log $ show $ IsoDuration.mkIsoDuration (Interval.year 2.5 <> Interval.week 1.0)
== Left (pure IsoDuration.InvalidWeekComponentUsage <> pure (IsoDuration.InvalidFractionalUse Interval.Year))
assert $ IsoDuration.mkIsoDuration (Interval.year 2.0 <> Interval.day (-1.0))
== Left (pure (IsoDuration.ContainsNegativeValue Interval.Day))
assert $ IsoDuration.mkIsoDuration (mempty)
== Left (pure IsoDuration.IsEmpty)

let epochDate = unsafePartial fromJust $ Date.canonicalDate
<$> toEnum 1
Expand Down