EditBar.hs

{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2016 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}
{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE TemplateHaskell #-}

module Mp.UI.EditBar (
    editBarNew
) where

import           Control.Lens                   (makeLensesFor)
import           Control.Monad
import           Control.Monad.IO.Class
import qualified Graphics.Vty                   as Vty
import           Simple.Locale.TranslateTH
import           Simple.UI.All
import           System.Directory               (doesFileExist)
import           System.FilePath.Posix          ((</>))

import           Mp.Configuration.Configuration
import           Mp.Locale.TranslateFile        ()
import           Mp.UI.MpData
import           Mp.UI.QuestionBar
import           Mp.UI.SongList

newtype EditBar = EditBar
    { _editBarParent :: Widget
    }

makeLensesFor [("_editBarParent", "editBarParent")] ''EditBar

instance WidgetClass EditBar where
    castToWidget = _editBarParent

    overrideWidget = overrideWidgetHelper editBarParent

editBarNew :: UIApp MpData EditBar
editBarNew = do
    mpData <- view appUserData

    layout1 <- fillLayoutVerticalNew
    container1 <- containerNew layout1

    layout2 <- fillLayoutHorizontalNew
    container2 <- containerNew layout2

    l1 <- labelNew $ Just ([tr|Enter playlist name|] ++ ": ")
    addTo container2 l1 def { fillLayoutHExpand = False }

    edit <- editNew Nothing
    addTo container2 edit def

    questionBar <- questionBarNew
    set questionBar visible False

    addTo container1 container2 def { fillLayoutVExpand = False }
    addTo container1 questionBar def { fillLayoutVExpand = False }

    on_ edit keyPressed $ \key _ ->
        case key of
            Vty.KEsc   -> do
                set edit text Nothing
                mainLoopQuit

            Vty.KEnter -> do
                _text <- get edit text
                forM_ _text $ \_name -> do
                    list <- readAttr $ mpData ^. mpSongList
                    dir <- liftIO playlistDirFilePath
                    exists <- liftIO $ doesFileExist (dir </> _name)
                    if exists
                        then do
                            set questionBar visible True
                            runDialogLoop questionBar
                            set questionBar visible False
                            _answer <- get questionBar answer
                            when (_answer == Yes) $
                                songListWrite (dir </> _name) list
                        else
                            songListWrite (dir </> _name) list

                    set edit text Nothing
                mainLoopQuit

            _          ->
                return ()

    container1 `connectColorsTo` l1
    container1 `connectColorsTo` edit

    set container1 colorForeground $ mpData ^. mpColors . editForeground
    set container1 colorBackground $ mpData ^. mpColors . editBackground

    let editBar = overrideWidget
                    EditBar { _editBarParent = castToWidget container1 }
                    $ virtualWidgetName .= "editbar"

    return editBar