{- * Programmer: Piotr Borek * E-mail: piotrborek@op.pl * Copyright 2017 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 TemplateHaskell #-} module Mp.UI.MpData ( MpData (..), mpColors, mpMusicDirectory, mpSongList, mpSongMap, mpSongInit, mpSongAdd, mpSongRemove, mpSongExists, module Mp.Configuration.AppColors ) where import Control.Lens import Control.Monad import Data.List import qualified Data.Map.Strict as Map import Simple.UI.All import Mp.Configuration.AppColors data MpData = MpData { _mpColors :: AppColors , _mpMusicDirectory :: String , _mpSongList :: Attribute [String] , _mpSongMap :: Attribute (Map.Map String Integer) } makeLenses ''MpData mpSongInit :: [String] -> UIApp MpData () mpSongInit songList = do mpData <- view appUserData writeAttr (mpData ^. mpSongList) songList let songList' = map (\x -> (x, 1)) songList writeAttr (mpData ^. mpSongMap) $ Map.fromList songList' mpSongAdd :: String -> UIApp MpData () mpSongAdd _name = do mpData <- view appUserData modifyAttr (mpData ^. mpSongList) $ \xs -> xs ++ [_name] modifyAttr (mpData ^. mpSongMap) $ \m -> let v = Map.lookup _name m in case v of Just x -> Map.insert _name (succ x) m Nothing -> Map.insert _name 1 m mpSongRemove :: String -> UIApp MpData Int mpSongRemove _name = do mpData <- view appUserData songList <- readAttr (mpData ^. mpSongList) let _indices = elemIndices _name songList when (null _indices) $ error "MpData.hs:79: indices == []" let _index = last _indices writeAttr (mpData ^. mpSongList) $ removeAt _index songList modifyAttr (mpData ^. mpSongMap) $ \songMap -> let v = Map.lookup _name songMap in case v of Just 1 -> Map.delete _name songMap Just _ -> Map.adjust pred _name songMap Nothing -> songMap return _index mpSongExists :: String -> UIApp MpData Bool mpSongExists _name = do mpData <- view appUserData songMap <- readAttr (mpData ^. mpSongMap) case Map.lookup _name songMap of Just v -> if v > 0 then return True else return False Nothing -> return False