module OrgStat.Ast
( Clock (..)
, Org (..)
, orgTitle
, orgTags
, orgClocks
, orgSubtrees
, fmapOrgLens
, traverseTree
, atDepth
, mergeClocks
) where
import Control.Lens (ASetter', makeLenses)
import Data.Time (LocalTime, diffUTCTime, localTimeToUTC, utc)
import Universum
data Clock = Clock
{ cFrom :: LocalTime
, cTo :: LocalTime
} deriving (Show,Eq,Ord)
data Org = Org
{ _orgTitle :: Text
, _orgTags :: [Text]
, _orgClocks :: [Clock]
, _orgSubtrees :: [Org]
} deriving (Show,Eq)
makeLenses ''Org
fmapOrgLens :: ASetter' Org a -> (a -> a) -> Org -> Org
fmapOrgLens l f o = o & l %~ f & orgSubtrees %~ map (fmapOrgLens l f)
traverseTree :: Traversal' Org Org
traverseTree f o = o'
where
o' = liftA2 (\org x -> org & orgSubtrees .~ x) (f o) traversedChildren
traversedChildren = traverse (traverseTree f) $ o ^. orgSubtrees
atDepth :: Int -> Traversal' Org Org
atDepth i _ o | i < 0 = pure o
atDepth 0 f o = f o
atDepth n f o =
(\x -> o & orgSubtrees .~ x) <$> traverse (atDepth (n1) f) (o ^. orgSubtrees)
mergeClocks :: Org -> Org
mergeClocks = fmapOrgLens orgClocks (mergeClocksDo . sort)
where
toUTC = localTimeToUTC utc
mergeClocksDo [] = []
mergeClocksDo [x] = [x]
mergeClocksDo (a:b:xs)
| toUTC (cFrom b) `diffUTCTime ` toUTC (cTo a) < 2*60 =
mergeClocksDo $ (Clock (cFrom a) (cTo b)):xs
| otherwise = a : mergeClocksDo (b:xs)