{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Safe #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Passman.Core.Config.Optional
-- Copyright   : Matthew Harm Bekkema 2016
-- License     : GPL-2
-- Maintainer  : mbekkema97@gmail.com
-- Stability   : experimental
-- Portability : POSIX
-----------------------------------------------------------------------------

module Passman.Core.Config.Optional
(
-- * OptionalConfig type
  OptionalConfig
-- * Query
, lookup
-- * Construction
, empty
-- * Insertion
, insert
-- * Delete/Update
, delete
, adjust
, update
, alter
) where

import Safe (readMay)
import Prelude (Read, Show, String, show, ($))

import Control.Monad
import Data.Functor
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map

-- | The optional configuration of the password manager
type OptionalConfig = Map String String

-- | Contains no configuration values
empty :: OptionalConfig
empty = Map.empty

-- | Lookup the value of a key in the config. Returns `Nothing` if key not
-- found, or if value can not be parsed as the desired type.
lookup :: Read a => String -> OptionalConfig -> Maybe a
lookup k m = Map.lookup k m >>= readMay

-- | Insert a new key and value in the config. If the key is already present,
-- the associated value is replaced with the supplied value.
insert :: Show a => String -> a -> OptionalConfig -> OptionalConfig
insert k v = Map.insert k (show v)

-- | Update a value at a specific key with the result of the provided function.
-- The value is left unchanged if it could not be parsed as the desired type.
adjust :: (Show a, Read a) => (a -> a) -> String -> OptionalConfig -> OptionalConfig
adjust f = Map.adjust f'
  where
    f' :: String -> String
    f' x = case readMay x of
        Nothing -> x
        Just v -> show $ f v

-- | Delete a key and its value from the config.
delete :: String -> OptionalConfig -> OptionalConfig
delete = Map.delete

-- | The expression (update f k config) updates the value x at k (if it is in
-- the config). If (f x) is Nothing, the element is deleted. If it is (Just y),
-- the key k is bound to the new value y. The value is left unchanged if it
-- could not be parsed as the desired type.
update :: (Show a, Read a) => (a -> Maybe a) -> String -> OptionalConfig -> OptionalConfig
update f = Map.update f'
  where
    f' :: String -> Maybe String
    f' x = case readMay x of
        Nothing -> Just x
        Just v -> show <$> f v

-- | The expression (alter f k config) alters the value x at k, or absence
-- thereof. The value is left unchanged if it could not be parsed as the desired
-- type.
alter :: (Show a, Read a) => (Maybe a -> Maybe a) -> String -> OptionalConfig -> OptionalConfig
alter f = Map.alter f'
  where
    f' :: Maybe String -> Maybe String
    f' Nothing = show <$> f Nothing
    f' (Just x) = case readMay x of
        Nothing -> Just x
        Just v  -> show <$> f v