{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE ExtendedDefaultRules       #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedLabels           #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}


module Main where


import           Control.Lens                  hiding (view)
import           Data.Generics.Labels          ()
import           Data.String
import           Data.Text                     hiding (count, filter, length)
import           GHC.Generics
import           Prelude                       hiding (div, unwords)
import           Shpadoinkle
import           Shpadoinkle.Backend.ParDiff
import           Shpadoinkle.Html
import           Shpadoinkle.Html.LocalStorage
import           Shpadoinkle.Html.Memo
import           Shpadoinkle.Lens


default (Text)


newtype Description = Description { unDescription :: Text } deriving (Generic, Show, Read, Eq, IsString)
newtype TaskId      = TaskId      { unTaskId      :: Int  } deriving (Generic, Show, Read, Eq, Ord, Num)


data Completed  = Complete | Incomplete
  deriving (Generic, Show, Read, Eq)


data Visibility = All | Active | Completed
  deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded)


data Task = Task
  { description :: Description
  , completed   :: Completed
  , taskId      :: TaskId
  } deriving (Generic, Show, Read, Eq)


data Model = Model
  { tasks      :: [Task]
  , editing    :: Maybe TaskId
  , visibility :: Visibility
  , current    :: Description
  } deriving (Generic, Show, Read, Eq)


emptyModel :: Model
emptyModel = Model [] Nothing All (Description "")


appendItem :: Model -> Model
appendItem m = if current m /= "" then m
  & #tasks   %~ (Task (current m) Incomplete newId :)
  & #current .~ "" else m
  where newId = Prelude.maximum (0 : (taskId <$> tasks m)) + 1


toggleCompleted :: TaskId -> Model -> Model
toggleCompleted tid m = m & #tasks . mapped %~ \t ->
  if taskId t == tid then t & #completed %~ negC else t
  where negC Complete   = Incomplete
        negC Incomplete = Complete


toggleEditing :: Maybe TaskId -> Model -> Model
toggleEditing t = #editing .~ t


updateTaskDescription :: TaskId -> Description -> Model -> Model
updateTaskDescription tid desc m = m & #tasks . mapped %~ \t ->
  if taskId t == tid then t & #description .~ desc else t


removeTask :: TaskId -> Model -> Model
removeTask tid m = m & #tasks %~ filter ((/= tid) . taskId)


toggleAll :: Model -> Model
toggleAll m = m & #tasks . traverse . #completed .~ c
  where c = if Prelude.all ((== Complete) . completed) $ tasks m then Incomplete else Complete


count :: Completed -> [Task] -> Int
count c = length . filter ((== c) . completed)


clearComplete :: Model -> Model
clearComplete = #tasks %~ filter ((== Incomplete) . completed)


toVisible :: Visibility -> [Task] -> [Task]
toVisible v = case v of
  All       -> id
  Active    -> filter $ (== Incomplete) . completed
  Completed -> filter $ (== Complete)   . completed


filterHtml :: Visibility -> Visibility -> Html m Visibility
filterHtml = memo2 $ \cur item -> li_
  [ a (href "#" : onClick item
        : [class' ("selected", cur == item)]) [ text . pack $ show item ]
  ]


htmlIfTasks :: Model -> [Html m a] -> [Html m a]
htmlIfTasks m h' = if Prelude.null (tasks m) then [] else h'


taskView :: Model -> Task -> Html m Model
taskView m = memo $ \(Task (Description d) c tid) ->
  li [ id' . pack . show $ unTaskId tid
     , class' [ ("completed", c == Complete)
              , ("editing", Just tid == editing m)
              ]
     ]
  [ div "view"
    [ input' [ type' "checkbox"
             , class' "toggle"
             , onChange $ toggleCompleted tid m
             , checked $ c == Complete
             ]
    , label [ onDblclick $ toggleEditing (Just tid) m ] [ text d ]
    , button' [ class' "destroy", onClick $ removeTask tid m ]
    ]
  , form [ onSubmit $ toggleEditing Nothing m ]
    [ input' [ class' "edit"
             , value d
             , onInput $ ($ m) . updateTaskDescription tid . Description
             , autofocus True
             , onBlur $ toggleEditing Nothing m
             ]
    ]
  ]


listFooter :: Functor m => Model -> Html m Model
listFooter model = footer "footer" $
  [ Shpadoinkle.Html.span "todo-count" $ let co = count Incomplete $ tasks model in
    [ strong_ [ text . pack $ show co ]
    , text $ " item" <> (if co == 1 then "" else "s") <> " left"
    ]
  , ul "filters" $ generalize #visibility .
      filterHtml (visibility model) <$> [minBound..maxBound]
  ] ++ (if count Complete (tasks model) == 0 then [] else
  [ button [ class' "clear-completed", onClick $ clearComplete model ] [ "Clear completed" ]
  ])



info :: Html m a
info = footer "info"
  [ p_ [ "Double-click to edit a todo" ]
  , p_ [ "Credits ", a [ href "https://twitter.com/fresheyeball" ] [ "Isaac Shapira" ] ]
  , p_ [ "Part of ", a [ href "http://todomvc.com" ] [ "TodoMVC" ] ]
  ]


newTaskForm :: Model -> Html m Model
newTaskForm model = form [ class' "todo-form", onSubmit (appendItem model) ]
  [ input' [ class' "new-todo"
           , value . unDescription $ current model
           , onInput $ ($ model) . (#current .~) . Description
           , placeholder "What needs to be done?" ]
  ]


todoList :: Model -> Html m Model
todoList model = ul "todo-list" $ taskView model <$> visibility model `toVisible` tasks model


toggleAllBtn :: Model -> [Html m Model]
toggleAllBtn model =
  [ input' [ id' "toggle-all", class' "toggle-all", type' "checkbox", onChange $ toggleAll model ]
  , label [ for' "toggle-all" ] [ "Mark all as complete" ]
  ]


view :: Functor m => Model -> Html m Model
view model = div_
  [ section "todoapp" $
    header "header"
      [ h1_ [ "todos" ], newTaskForm model ]
    : htmlIfTasks model
    [ section "main" $ toggleAllBtn model <> [ todoList model ]
    , listFooter model
    ]
  , info
  ]


app :: JSM ()
app = do
  model <- manageLocalStorage "todo" emptyModel
  initial <- readTVarIO model
  addStyle "https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.css"
  addStyle "https://cdn.jsdelivr.net/npm/todomvc-app-css@2.2.0/index.css"
  shpadoinkle id runParDiff initial model view getBody


main :: IO ()
main = do
  putStrLn "running app"
  runJSorWarp 8080 app