{-# LANGUAGE TemplateHaskell #-}

module Taskell.Data.Subtask where

import ClassyPrelude
import Control.Lens  (makeLenses, (%~))

data Subtask = Subtask
    { Subtask -> Text
_name     :: Text
    , Subtask -> Bool
_complete :: Bool
    } deriving (Int -> Subtask -> ShowS
[Subtask] -> ShowS
Subtask -> String
(Int -> Subtask -> ShowS)
-> (Subtask -> String) -> ([Subtask] -> ShowS) -> Show Subtask
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subtask] -> ShowS
$cshowList :: [Subtask] -> ShowS
show :: Subtask -> String
$cshow :: Subtask -> String
showsPrec :: Int -> Subtask -> ShowS
$cshowsPrec :: Int -> Subtask -> ShowS
Show, Subtask -> Subtask -> Bool
(Subtask -> Subtask -> Bool)
-> (Subtask -> Subtask -> Bool) -> Eq Subtask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subtask -> Subtask -> Bool
$c/= :: Subtask -> Subtask -> Bool
== :: Subtask -> Subtask -> Bool
$c== :: Subtask -> Subtask -> Bool
Eq)

type Update = Subtask -> Subtask

-- create lenses
$(makeLenses ''Subtask)

-- operations
blank :: Subtask
blank :: Subtask
blank = Text -> Bool -> Subtask
Subtask Text
"" Bool
False

new :: Text -> Bool -> Subtask
new :: Text -> Bool -> Subtask
new = Text -> Bool -> Subtask
Subtask

toggle :: Update
toggle :: Update
toggle = (Bool -> Identity Bool) -> Subtask -> Identity Subtask
Lens' Subtask Bool
complete ((Bool -> Identity Bool) -> Subtask -> Identity Subtask)
-> (Bool -> Bool) -> Update
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not

duplicate :: Subtask -> Subtask
duplicate :: Update
duplicate (Subtask Text
n Bool
c) = Text -> Bool -> Subtask
Subtask Text
n Bool
c