{-# 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                   (IsString)
import           Data.Text                     hiding (count, filter, length)
import           GHC.Generics                  (Generic)
import           Prelude                       hiding (div, unwords)
import           Shpadoinkle                   (Html, JSM, readTVarIO,
                                                shpadoinkle, text)
import           Shpadoinkle.Backend.Snabbdom  (runSnabbdom, stage)
import           Shpadoinkle.Html              (a, addStyle, autofocus, button,
                                                button', checked, class', div,
                                                div_, footer, for', form, h1_,
                                                header, href, id', input',
                                                label, li, li_, onBlur,
                                                onChange, onClick, onDblclick,
                                                onInput, onSubmit, p_,
                                                placeholder, section, span,
                                                strong_, type', ul, value)
import           Shpadoinkle.Html.LocalStorage (manageLocalStorage)
import           Shpadoinkle.Html.Memo         (memo)
import           Shpadoinkle.Lens              (generalize)
import           Shpadoinkle.Run               (runJSorWarp)


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 = memo $ \cur item -> li_
  [ a (href "#" : onClick (const 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
             , checked $ c == Complete
             ]
    , label [ onDblclick $ toggleEditing (Just tid) ] [ text d ]
    , button' [ class' "destroy", onClick $ removeTask tid ]
    ]
  , form [ onSubmit $ toggleEditing Nothing ]
    [ input' [ class' "edit"
             , value d
             , onInput $ updateTaskDescription tid . Description
             , autofocus True
             , onBlur $ toggleEditing Nothing
             ]
    ]
  ]


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]
  ] ++ [ button [class' "clear-completed", onClick clearComplete ] ["Clear completed"]
       | count Complete (tasks model) /= 0 ]



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 ]
  [ input' [ class' "new-todo"
           , value . unDescription $ current model
           , onInput $ (#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 :: [Html m Model]
toggleAllBtn =
  [ input' [ id' "toggle-all", class' "toggle-all", type' "checkbox", onChange toggleAll ]
  , 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 <> [ 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 runSnabbdom initial model view stage


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