Inputs.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}

module Panes.Common.Inputs
  -- (
  -- )
where

import           Brick hiding ( Location )
import           Brick.Forms
import           Control.Lens
import           Control.Monad.IO.Class ( MonadIO, liftIO )
import           Data.Text ( Text )
import qualified Data.Text as T
import           Data.Time.Calendar ( Day )
import           Path ( parseAbsDir )
import           Path.IO ( doesDirExist, doesDirExist )

import           Defs



headText :: [Text] -> Text
headText = \case
  [] -> ""
  (o:_) -> o


locationInput :: [Location]
              -> Maybe Location
              -> Bool
              -> Lens' s LocationSpec
              -> s
              -> FormFieldState s e WName
locationInput locs mbLoc blankAllowed stateLens =
  let validate = \case
        [] -> if blankAllowed
              then Just (RemoteSpec "")
              else Nothing
        (l:_) ->
          let lr = RemoteSpec l
              ll = parseAbsDir $ T.unpack l
              ls = T.unpack l
          in if or
                [
                  -- Should not match any existing location
                  and [ ls `elem` (show . view locationL <$> locs)
                      , maybe True ((ls /=) . show . view locationL) mbLoc
                      ]

                  -- Check blank v.s. allowed and should be an absolute path if
                  -- it looks like a local path
                , and [ not blankAllowed
                      , maybe (isLocationTextLocal (T.pack ls)) (const False) ll
                      ]
                ]
             then Nothing  -- invalid
             else Just $ maybe lr LocalSpec ll
  in editField stateLens (WName "New Location") (Just 1)
     (T.pack . show) validate (txt . headText) id


validateLocationInput :: MonadIO m => Bool -> LocationSpec -> m (WName, Bool)
validateLocationInput blankAllowed l =
  let tgt = WName "New Location"
      ls = T.pack $ show l
  in if blankAllowed && T.null ls
     then return (tgt, True)
     else case l of
            LocalSpec lp -> (tgt,) <$> (liftIO $ doesDirExist lp)
            RemoteSpec _ -> return (tgt, True)


mbDateInput :: Lens' s (Maybe Day)
            -> s
            -> FormFieldState s e WName
mbDateInput stateLens =
  let validate = \case
        ("":_) -> Just Nothing
        (l:_) -> Just <$> textToDay l
        _ -> Nothing
      dayInit = maybe "" (T.pack . show)
      dayRender = txt . headText
  in editField stateLens (WName "Location Date (Y-M-D)")
     (Just 1) dayInit validate dayRender id