{-# LANGUAGE TypeFamilies, DeriveGeneric, DeriveAnyClass, OverloadedStrings #-} module TodoStore where import React.Flux import Control.DeepSeq import GHC.Generics (Generic) import Data.Typeable (Typeable) import qualified Data.Text as T data Todo = Todo { todoText :: T.Text , todoComplete :: Bool , todoIsEditing :: Bool } deriving (Show, Typeable) newtype TodoState = TodoState { todoList :: [(Int, Todo)] } deriving (Show, Typeable) data TodoAction = TodoCreate T.Text | TodoDelete Int | TodoEdit Int | UpdateText Int T.Text | ToggleAllComplete | TodoSetComplete Int Bool | ClearCompletedTodos deriving (Show, Typeable, Generic, NFData) instance StoreData TodoState where type StoreAction TodoState = TodoAction transform action (TodoState todos) = do putStrLn $ "Action: " ++ show action putStrLn $ "Initial todos: " ++ show todos -- Care is taken here to leave the Haskell object for the pair (Int, Todo) unchanged if the todo -- itself is unchanged. This allows React to avoid re-rendering the todo when it does not change. -- For more, see the "Performance" section of the React.Flux haddocks. newTodos <- return $ case action of (TodoCreate txt) -> (maximum (map fst todos) + 1, Todo txt False False) : todos (TodoDelete i) -> filter ((/=i) . fst) todos (TodoEdit i) -> let f (idx, todo) | idx == i = (idx, todo { todoIsEditing = True }) f p = p in map f todos (UpdateText newIdx newTxt) -> let f (idx, todo) | idx == newIdx = (idx, todo { todoText = newTxt, todoIsEditing = False }) f p = p in map f todos ToggleAllComplete -> [ (idx, Todo txt True False) | (idx, Todo txt _ _) <- todos ] TodoSetComplete newIdx newComplete -> let f (idx, todo) | idx == newIdx = (idx, todo { todoComplete = newComplete }) f p = p in map f todos ClearCompletedTodos -> filter (not . todoComplete . snd) todos putStrLn $ "New todos: " ++ show newTodos return $ TodoState newTodos todoStore :: ReactStore TodoState todoStore = mkStore $ TodoState [ (0, Todo "Learn react" True False) , (1, Todo "Learn react-flux" False False) ]