module T4.Data where

import Data.Char
import Data.Function
import Data.Maybe
import qualified Data.Text as T
import Data.Set (Set)
import qualified Data.Set as S
import Data.Map (Map)
import qualified Data.Map as M
import Data.Time
import Data.Aeson
import Data.Aeson.TH

newtype SimpleLocalTime = SLT {SimpleLocalTime -> LocalTime
getLocalTime :: LocalTime}
                          deriving (SimpleLocalTime -> SimpleLocalTime -> Bool
(SimpleLocalTime -> SimpleLocalTime -> Bool)
-> (SimpleLocalTime -> SimpleLocalTime -> Bool)
-> Eq SimpleLocalTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleLocalTime -> SimpleLocalTime -> Bool
== :: SimpleLocalTime -> SimpleLocalTime -> Bool
$c/= :: SimpleLocalTime -> SimpleLocalTime -> Bool
/= :: SimpleLocalTime -> SimpleLocalTime -> Bool
Eq, Int -> SimpleLocalTime -> ShowS
[SimpleLocalTime] -> ShowS
SimpleLocalTime -> [Char]
(Int -> SimpleLocalTime -> ShowS)
-> (SimpleLocalTime -> [Char])
-> ([SimpleLocalTime] -> ShowS)
-> Show SimpleLocalTime
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleLocalTime -> ShowS
showsPrec :: Int -> SimpleLocalTime -> ShowS
$cshow :: SimpleLocalTime -> [Char]
show :: SimpleLocalTime -> [Char]
$cshowList :: [SimpleLocalTime] -> ShowS
showList :: [SimpleLocalTime] -> ShowS
Show, Eq SimpleLocalTime
Eq SimpleLocalTime =>
(SimpleLocalTime -> SimpleLocalTime -> Ordering)
-> (SimpleLocalTime -> SimpleLocalTime -> Bool)
-> (SimpleLocalTime -> SimpleLocalTime -> Bool)
-> (SimpleLocalTime -> SimpleLocalTime -> Bool)
-> (SimpleLocalTime -> SimpleLocalTime -> Bool)
-> (SimpleLocalTime -> SimpleLocalTime -> SimpleLocalTime)
-> (SimpleLocalTime -> SimpleLocalTime -> SimpleLocalTime)
-> Ord SimpleLocalTime
SimpleLocalTime -> SimpleLocalTime -> Bool
SimpleLocalTime -> SimpleLocalTime -> Ordering
SimpleLocalTime -> SimpleLocalTime -> SimpleLocalTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SimpleLocalTime -> SimpleLocalTime -> Ordering
compare :: SimpleLocalTime -> SimpleLocalTime -> Ordering
$c< :: SimpleLocalTime -> SimpleLocalTime -> Bool
< :: SimpleLocalTime -> SimpleLocalTime -> Bool
$c<= :: SimpleLocalTime -> SimpleLocalTime -> Bool
<= :: SimpleLocalTime -> SimpleLocalTime -> Bool
$c> :: SimpleLocalTime -> SimpleLocalTime -> Bool
> :: SimpleLocalTime -> SimpleLocalTime -> Bool
$c>= :: SimpleLocalTime -> SimpleLocalTime -> Bool
>= :: SimpleLocalTime -> SimpleLocalTime -> Bool
$cmax :: SimpleLocalTime -> SimpleLocalTime -> SimpleLocalTime
max :: SimpleLocalTime -> SimpleLocalTime -> SimpleLocalTime
$cmin :: SimpleLocalTime -> SimpleLocalTime -> SimpleLocalTime
min :: SimpleLocalTime -> SimpleLocalTime -> SimpleLocalTime
Ord, Maybe SimpleLocalTime
Value -> Parser [SimpleLocalTime]
Value -> Parser SimpleLocalTime
(Value -> Parser SimpleLocalTime)
-> (Value -> Parser [SimpleLocalTime])
-> Maybe SimpleLocalTime
-> FromJSON SimpleLocalTime
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SimpleLocalTime
parseJSON :: Value -> Parser SimpleLocalTime
$cparseJSONList :: Value -> Parser [SimpleLocalTime]
parseJSONList :: Value -> Parser [SimpleLocalTime]
$comittedField :: Maybe SimpleLocalTime
omittedField :: Maybe SimpleLocalTime
FromJSON)

simpleLocalTime :: Int -> Int -> Int -> Int -> Int -> Int -> SimpleLocalTime
simpleLocalTime :: Int -> Int -> Int -> Int -> Int -> Int -> SimpleLocalTime
simpleLocalTime Int
y Int
m Int
d Int
h Int
i Int
s =
  let day :: Day
day = Year -> Int -> Int -> Day
fromGregorian (Int -> Year
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) Int
m Int
d
      tod :: TimeOfDay
tod = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
i (Int -> Pico
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s)
  in  LocalTime -> SimpleLocalTime
SLT (Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
tod)

formatSLT :: String -> SimpleLocalTime -> String
formatSLT :: [Char] -> SimpleLocalTime -> [Char]
formatSLT [Char]
fmt = TimeLocale -> [Char] -> LocalTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
fmt (LocalTime -> [Char])
-> (SimpleLocalTime -> LocalTime) -> SimpleLocalTime -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleLocalTime -> LocalTime
getLocalTime

dateString :: SimpleLocalTime -> String
dateString :: SimpleLocalTime -> [Char]
dateString = [Char] -> SimpleLocalTime -> [Char]
formatSLT [Char]
"%F"

timeString :: SimpleLocalTime -> String
timeString :: SimpleLocalTime -> [Char]
timeString = [Char] -> SimpleLocalTime -> [Char]
formatSLT [Char]
"%T"

sltString :: SimpleLocalTime -> String
sltString :: SimpleLocalTime -> [Char]
sltString = [Char] -> SimpleLocalTime -> [Char]
formatSLT [Char]
"%F %T"

instance ToJSON SimpleLocalTime where
  toJSON :: SimpleLocalTime -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (SimpleLocalTime -> Text) -> SimpleLocalTime -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text)
-> (SimpleLocalTime -> [Char]) -> SimpleLocalTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleLocalTime -> [Char]
sltString

type Category = String
type Tag      = String

data Clock  = In  { Clock -> SimpleLocalTime
time      :: SimpleLocalTime
                  , Clock -> Maybe [Char]
category  :: Maybe Category
                  , Clock -> Set [Char]
tags      :: Set Tag
                  }
            | Out { time      :: SimpleLocalTime
                  }
              deriving (Int -> Clock -> ShowS
[Clock] -> ShowS
Clock -> [Char]
(Int -> Clock -> ShowS)
-> (Clock -> [Char]) -> ([Clock] -> ShowS) -> Show Clock
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Clock -> ShowS
showsPrec :: Int -> Clock -> ShowS
$cshow :: Clock -> [Char]
show :: Clock -> [Char]
$cshowList :: [Clock] -> ShowS
showList :: [Clock] -> ShowS
Show, Clock -> Clock -> Bool
(Clock -> Clock -> Bool) -> (Clock -> Clock -> Bool) -> Eq Clock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Clock -> Clock -> Bool
== :: Clock -> Clock -> Bool
$c/= :: Clock -> Clock -> Bool
/= :: Clock -> Clock -> Bool
Eq)

instance Ord Clock where
  <= :: Clock -> Clock -> Bool
(<=) = SimpleLocalTime -> SimpleLocalTime -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (SimpleLocalTime -> SimpleLocalTime -> Bool)
-> (Clock -> SimpleLocalTime) -> Clock -> Clock -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Clock -> SimpleLocalTime
time

$(deriveJSON defaultOptions
  { constructorTagModifier  = map toLower
  , sumEncoding             = ObjectWithSingleField
  } ''Clock)

isIn :: Clock -> Bool
isIn :: Clock -> Bool
isIn (In {}) = Bool
True; isIn Clock
_ = Bool
False

isOut :: Clock -> Bool
isOut :: Clock -> Bool
isOut (Out {}) = Bool
True; isOut Clock
_ = Bool
False

getDay :: Clock -> Day
getDay :: Clock -> Day
getDay = LocalTime -> Day
localDay (LocalTime -> Day) -> (Clock -> LocalTime) -> Clock -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleLocalTime -> LocalTime
getLocalTime (SimpleLocalTime -> LocalTime)
-> (Clock -> SimpleLocalTime) -> Clock -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clock -> SimpleLocalTime
time

summary :: Clock -> String
summary :: Clock -> [Char]
summary (Out SimpleLocalTime
t)       = [Char]
"OUT (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleLocalTime -> [Char]
sltString SimpleLocalTime
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"
summary (In SimpleLocalTime
t Maybe [Char]
mc Set [Char]
ts)  = [Char]
"IN (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ SimpleLocalTime -> [Char]
sltString SimpleLocalTime
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
catStr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
tagsStr
  where catStr :: [Char]
catStr  = [Char] -> ShowS -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (([Char]
" [" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]")) Maybe [Char]
mc
        tagsStr :: [Char]
tagsStr = ShowS -> Set [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char]
" #" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) Set [Char]
ts

type Clocks = Set Clock

dayGroups :: Clocks -> Map Day Clocks
dayGroups :: Clocks -> Map Day Clocks
dayGroups = (Clock -> Map Day Clocks -> Map Day Clocks)
-> Map Day Clocks -> Clocks -> Map Day Clocks
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Clock -> Map Day Clocks -> Map Day Clocks
combine Map Day Clocks
forall k a. Map k a
M.empty
  where combine :: Clock -> Map Day Clocks -> Map Day Clocks
combine = (Clocks -> Clocks -> Clocks)
-> Day -> Clocks -> Map Day Clocks -> Map Day Clocks
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Clocks -> Clocks -> Clocks
forall a. Ord a => Set a -> Set a -> Set a
S.union (Day -> Clocks -> Map Day Clocks -> Map Day Clocks)
-> (Clock -> Day)
-> Clock
-> Clocks
-> Map Day Clocks
-> Map Day Clocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> Day
getDay (Clock -> Clocks -> Map Day Clocks -> Map Day Clocks)
-> (Clock -> Clocks) -> Clock -> Map Day Clocks -> Map Day Clocks
forall a b. (Clock -> a -> b) -> (Clock -> a) -> Clock -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Clock -> Clocks
forall a. a -> Set a
S.singleton

allCategories :: Clocks -> Set Category
allCategories :: Clocks -> Set [Char]
allCategories = [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
S.fromList ([[Char]] -> Set [Char])
-> (Clocks -> [[Char]]) -> Clocks -> Set [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Clock -> Maybe [Char]) -> [Clock] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Clock -> Maybe [Char]
category ([Clock] -> [[Char]]) -> (Clocks -> [Clock]) -> Clocks -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clocks -> [Clock]
forall a. Set a -> [a]
S.toList (Clocks -> [Clock]) -> (Clocks -> Clocks) -> Clocks -> [Clock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Clock -> Bool) -> Clocks -> Clocks
forall a. (a -> Bool) -> Set a -> Set a
S.filter Clock -> Bool
isIn

allTags :: Clocks -> Set Tag
allTags :: Clocks -> Set [Char]
allTags = Set (Set [Char]) -> Set [Char]
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (Set (Set [Char]) -> Set [Char])
-> (Clocks -> Set (Set [Char])) -> Clocks -> Set [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Clock -> Set [Char]) -> Clocks -> Set (Set [Char])
forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map Clock -> Set [Char]
tags (Clocks -> Set (Set [Char]))
-> (Clocks -> Clocks) -> Clocks -> Set (Set [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Clock -> Bool) -> Clocks -> Clocks
forall a. (a -> Bool) -> Set a -> Set a
S.filter Clock -> Bool
isIn