content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE FlexibleContexts #-}
  module Buchhaltung.Ask where
  
  import           Buchhaltung.Types
  import           Control.Arrow
  import           Control.Monad
  import           Control.Monad.Reader
  import           Control.Monad.Trans.Class
  import           Data.Char
  import           Data.Function
  import           Data.List
  import           Data.List.Split
  import           Data.Maybe
  import           Data.Monoid
  import qualified Data.Text as T
  import           Hledger.Data.Types
  import           System.Console.Haskeline
  import           System.Console.Haskeline.History
  
  
  -- ############## Readline editing loops ############
                 
  editLoop :: MonadException m =>
               (T.Text -> Either String c) -- ^ input to value extractor
              -> String -- ^ history File suffix
              -> Maybe (c, T.Text) -- ^ Default value and its string
              -> Maybe [T.Text] -- ^ completion list
              -> Either T.Text T.Text -- ^ use promtp: Left promp ++ [Def]:, or Right prompt
              -> Maybe T.Text -- ^ intitial readline text
              -> m c
  editLoop extractor = editLoopM $ return . extractor 
    
  editLoopM :: MonadException m =>
               (T.Text -> m (Either String c)) -- ^ input to value extractor
              -> String -- ^ history File suffix
              -> Maybe (c, T.Text) -- ^ Default value and its string
              -> Maybe [T.Text] -- ^ completion list
              -> Either T.Text T.Text -- ^ use promtp: Left promp ++ [Def]:, or Right prompt
              -> Maybe T.Text -- ^ intitial readline text
              -> m c
  editLoopM extract histFileSuf def completionList prompt init =
    runInputT2 settings loop
    where loop =  do s <- fromJust <$> getInput
                     let useDef = if s=="" then Just fst else Nothing
                         tryExtract = do
                           modifyHistory $ addHistoryRemovingAllDupes s
                           either ((>> loop) . outputStr . (++"\n")) return =<<
                             (lift $ extract $ T.pack s)
                     maybe tryExtract return $ useDef <*> def
          getInput = getInputLineWithInitial (T.unpack prompt')
                     (maybe "" T.unpack init, "")
          prompt' = either (<>(maybe ": " (\x -> " ["<> snd x <>"]: ") def)) id prompt :: T.Text
          settings = Settings {  historyFile = histFile  histFileSuf
                              ,complete = completeFunc, autoAddHistory = False }
          completeFunc = maybe noCompletion (customCompl . fmap T.unpack)
                         completionList
          customCompl list = completeWord Nothing "" -- don't break words on whitespace, since account names
                                                      -- can contain spaces.
                             $ \s -> return $ map (g s) $ filter (on f (toLower<$>) s) list
            where g s x = Completion y x False
                    where y = concat $ "" : tail (ciSplitOn s x)
                  f s = (||) <$> isPrefixOf s <*> isInfixOf (":"++s)
  histFile suf = Just $  ".haskeline_history_"++suf
  
  -- case insensitive char
  newtype CiChar = CiChar { ciChar :: Char }
  instance Eq CiChar where
    (==) = (==) `on` (toLower . ciChar)
  
  -- ciSplitOn s x = (ciChar<$>) <$> (on splitOn (CiChar<$>) s x)
  ciSplitOn s x = (ciChar<$>) <$> (on (split . onSublist) (CiChar<$>) s x)
  
  myGetchar :: IO Char
  myGetchar = fromJust <$> runInputT2 defaultSettings ( getInputChar "your action: ")
  
  runInputT2 s i = runInputT s $ withInterrupt $ handle
                  (\Interrupt -> outputStrLn "you will loose all unsaved data!" >> i) i
  
    
  -- ziplist action        
  editHaskeline :: (a -> String) -> (a -> String -> a) -> a -> IO a
  editHaskeline show modify v = liftM (modify v . fromJust) $
                                runInputT2 defaultSettings{historyFile = Just ".haskeline_history"} $
                                getInputLineWithInitial "edit: " (show v,"")
  
  askAccount :: (MonadReader (Options User config env) m, MonadIO m)
               => [AccountName] -- ^ completion list
               -> Maybe AccountName -- ^ default value, if "" is entered
               -> Maybe String -- ^ history file suffix
               -> Either T.Text T.Text -- ^ prompt
               -> m AccountName
  askAccount completionList def suf pr = do
    revAccount <- askReverseAccount
    fmap revAccount . liftIO $ editLoop (maybe notNull (const Right) def)
      (fromMaybe "Account" suf)
      ((id &&& id) . revAccount <$> def)
      (Just $ revAccount <$> completionList) pr Nothing --def
    where notNull s = if s=="" then Left "Blank Account not allowed"
                      else Right s
                                         
  askReverseAccount :: MonadReader (Options User config env) m => m (T.Text -> T.Text)
  askReverseAccount = g <$> readUser reverseAccountInput
    where g x = if fromMaybe True x then T.intercalate ":" . reverse . T.splitOn ":"
                else id
  