{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-- | A wrapper for <https://en.wikipedia.org/wiki/Zenity Zenity> dialog boxes
--
-- Zenity is accessed through system calls, so it needs to be installed on the
-- computer in order for this wrapper to work.
--
-- It is advised to turn on the following extensions when using this module:
--
-- > DuplicateRecordFields
-- > OverloadedStrings
--
-- Here is a simple example for how to use the library. It asks the user for a
-- name and displays a greeting:
--
-- @
-- {-\# LANGUAGE DuplicateRecordFields \#-}
-- {-\# LANGUAGE OverloadedStrings \#-}
--
-- import "Data.Monoid"
-- import "Zenity"
--
-- greeting = do
--   Just name <-
--     `zenity` `def` {title = Just "Name entry"} $
--       `Entry` $ `def` {text = Just "What's your name?"}
--   `zenity` `def` $ `Info` `def` {text = Just $ "Greetings, " <> name <> "!"}
-- @
--
-- More examples can be found in the
-- <https://github.com/emilaxelsson/hzenity/tree/master/examples examples/>
-- directory.
module Zenity
  ( Text
  , Day
  , Default (..)

    -- * Zenity dialogs
  , Config (..)
  , CalendarFlags (..)
  , EntryFlags (..)
  , FileSelectionFlags (..)
  , InfoFlags (..)
  , ReturnedColumn (..)
  , ListFlags (..)
  , SelectionHeader (..)
  , ListType (..)
  , radio
  , check
  , Matrix (..)
  , Dialog (..)
  , zenity

    -- ** Extra dialogs
  , keyedList
  ) where

import Control.Monad (void, when)
import Data.Bool (bool)
import Data.Default (Default (..))
import Data.String (IsString)
import Data.Text (Text)
import Data.Time.Calendar (Day)
import Data.Time.Format (defaultTimeLocale, parseTimeM)
import qualified Data.Text as Text
import qualified System.Process.Text as Text
import System.Process (showCommandForUser)

#if MIN_VERSION_base(4,13,0)
#else
import Control.Monad.Fail (MonadFail)
import Data.Word (Word)
#endif



-- | Chop a list into chunks of size @n@
chunk :: Int -> [a] -> [[a]]
chunk :: Int -> [a] -> [[a]]
chunk Int
n [a]
as
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 = Int -> [a] -> [[a]]
go ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as) [a]
as
  | Bool
otherwise = [Char] -> [[a]]
forall a. HasCallStack => [Char] -> a
error [Char]
"chunk: chunk size must be >= 1"
  where
    go :: Int -> [a] -> [[a]]
go Int
l [a]
bs
      | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = [[a]
bs]
      | Bool
otherwise = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
bs [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
go (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
bs)



--------------------------------------------------------------------------------
-- * Zenity
--------------------------------------------------------------------------------

-- | General Zenity configuration
--
-- Use 'def' for default configuration.
data Config = Config
  { Config -> Maybe Text
title :: Maybe Text -- ^ Dialog title
  , Config -> Maybe [Char]
windowIcon :: Maybe FilePath
      -- ^ Window icon with the path to an image. Alternatively, one of the four
      -- stock icons can be used: @error@, @info@, @question@ or @warning@.
  , Config -> Maybe Int
width :: Maybe Int -- ^ Dialog width
  , Config -> Maybe Int
height :: Maybe Int -- ^ Dialog height
  , Config -> Maybe Int
timeout :: Maybe Int -- ^ Dialog timeout in seconds
  , Config -> Bool
debug :: Bool -- ^ Print the system call to Zenity with flags
  }

instance Default Config where
  def :: Config
def = Config :: Maybe Text
-> Maybe [Char]
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Bool
-> Config
Config
    { $sel:title:Config :: Maybe Text
title = Maybe Text
forall a. Maybe a
Nothing
    , $sel:windowIcon:Config :: Maybe [Char]
windowIcon = Maybe [Char]
forall a. Maybe a
Nothing
    , $sel:width:Config :: Maybe Int
width = Maybe Int
forall a. Maybe a
Nothing
    , $sel:height:Config :: Maybe Int
height = Maybe Int
forall a. Maybe a
Nothing
    , $sel:timeout:Config :: Maybe Int
timeout = Maybe Int
forall a. Maybe a
Nothing
    , $sel:debug:Config :: Bool
debug = Bool
False
    }

data CmdFlag where
  CmdFlag
    :: { CmdFlag -> [Char]
_flagName :: String
       , ()
_flagField :: Maybe a
       , ()
_flagParam :: a -> String}
    -> CmdFlag

cmdFlag :: CmdFlag -> [String]
cmdFlag :: CmdFlag -> [[Char]]
cmdFlag (CmdFlag [Char]
flag Maybe a
fld a -> [Char]
mkParam) = [[Char]] -> (a -> [[Char]]) -> Maybe a -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\a
f -> [[Char]
flag, a -> [Char]
mkParam a
f]) Maybe a
fld

configFlags :: Config -> [String]
configFlags :: Config -> [[Char]]
configFlags Config {Bool
Maybe Int
Maybe [Char]
Maybe Text
debug :: Bool
timeout :: Maybe Int
height :: Maybe Int
width :: Maybe Int
windowIcon :: Maybe [Char]
title :: Maybe Text
$sel:debug:Config :: Config -> Bool
$sel:timeout:Config :: Config -> Maybe Int
$sel:height:Config :: Config -> Maybe Int
$sel:width:Config :: Config -> Maybe Int
$sel:windowIcon:Config :: Config -> Maybe [Char]
$sel:title:Config :: Config -> Maybe Text
..} =
  (CmdFlag -> [[Char]]) -> [CmdFlag] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
    CmdFlag -> [[Char]]
cmdFlag
    [ [Char] -> Maybe Text -> (Text -> [Char]) -> CmdFlag
forall a. [Char] -> Maybe a -> (a -> [Char]) -> CmdFlag
CmdFlag [Char]
"--title" Maybe Text
title Text -> [Char]
Text.unpack
    , [Char] -> Maybe [Char] -> ([Char] -> [Char]) -> CmdFlag
forall a. [Char] -> Maybe a -> (a -> [Char]) -> CmdFlag
CmdFlag [Char]
"--window-icon" Maybe [Char]
windowIcon [Char] -> [Char]
forall a. a -> a
id
    , [Char] -> Maybe Int -> (Int -> [Char]) -> CmdFlag
forall a. [Char] -> Maybe a -> (a -> [Char]) -> CmdFlag
CmdFlag [Char]
"--width" Maybe Int
width Int -> [Char]
forall a. Show a => a -> [Char]
show
    , [Char] -> Maybe Int -> (Int -> [Char]) -> CmdFlag
forall a. [Char] -> Maybe a -> (a -> [Char]) -> CmdFlag
CmdFlag [Char]
"--height" Maybe Int
height Int -> [Char]
forall a. Show a => a -> [Char]
show
    , [Char] -> Maybe Int -> (Int -> [Char]) -> CmdFlag
forall a. [Char] -> Maybe a -> (a -> [Char]) -> CmdFlag
CmdFlag [Char]
"--timeout" Maybe Int
timeout Int -> [Char]
forall a. Show a => a -> [Char]
show
    ]

class CmdParam p where
  serializeParam :: p -> [String]

boolParam :: Bool -> String -> [String]
boolParam :: Bool -> [Char] -> [[Char]]
boolParam Bool
param [Char]
flag = [[Char]] -> [[Char]] -> Bool -> [[Char]]
forall a. a -> a -> Bool -> a
bool [] [[Char]
flag] Bool
param

maybeParam :: Maybe a -> (a -> [String]) -> [String]
maybeParam :: Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam = ((a -> [[Char]]) -> Maybe a -> [[Char]])
-> Maybe a -> (a -> [[Char]]) -> [[Char]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a -> [[Char]]) -> Maybe a -> [[Char]])
 -> Maybe a -> (a -> [[Char]]) -> [[Char]])
-> ((a -> [[Char]]) -> Maybe a -> [[Char]])
-> Maybe a
-> (a -> [[Char]])
-> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> (a -> [[Char]]) -> Maybe a -> [[Char]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe []

-- | Flags for the 'Calendar' dialog
--
-- Use 'def' for default flags.
data CalendarFlags = CalendarFlags
  { CalendarFlags -> Maybe Text
text :: Maybe Text -- ^ Dialog text
  , CalendarFlags -> Maybe Word
year :: Maybe Word -- ^ Calendar year
  , CalendarFlags -> Maybe Word
month :: Maybe Word -- ^ Calendar month
  , CalendarFlags -> Maybe Word
day :: Maybe Word -- ^ Calendar day
  } deriving (CalendarFlags -> CalendarFlags -> Bool
(CalendarFlags -> CalendarFlags -> Bool)
-> (CalendarFlags -> CalendarFlags -> Bool) -> Eq CalendarFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CalendarFlags -> CalendarFlags -> Bool
$c/= :: CalendarFlags -> CalendarFlags -> Bool
== :: CalendarFlags -> CalendarFlags -> Bool
$c== :: CalendarFlags -> CalendarFlags -> Bool
Eq, Int -> CalendarFlags -> [Char] -> [Char]
[CalendarFlags] -> [Char] -> [Char]
CalendarFlags -> [Char]
(Int -> CalendarFlags -> [Char] -> [Char])
-> (CalendarFlags -> [Char])
-> ([CalendarFlags] -> [Char] -> [Char])
-> Show CalendarFlags
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [CalendarFlags] -> [Char] -> [Char]
$cshowList :: [CalendarFlags] -> [Char] -> [Char]
show :: CalendarFlags -> [Char]
$cshow :: CalendarFlags -> [Char]
showsPrec :: Int -> CalendarFlags -> [Char] -> [Char]
$cshowsPrec :: Int -> CalendarFlags -> [Char] -> [Char]
Show)

instance Default CalendarFlags where
  def :: CalendarFlags
def = Maybe Text
-> Maybe Word -> Maybe Word -> Maybe Word -> CalendarFlags
CalendarFlags Maybe Text
forall a. Maybe a
Nothing Maybe Word
forall a. Maybe a
Nothing Maybe Word
forall a. Maybe a
Nothing Maybe Word
forall a. Maybe a
Nothing

instance CmdParam CalendarFlags where
  serializeParam :: CalendarFlags -> [[Char]]
serializeParam CalendarFlags {Maybe Word
Maybe Text
day :: Maybe Word
month :: Maybe Word
year :: Maybe Word
text :: Maybe Text
$sel:day:CalendarFlags :: CalendarFlags -> Maybe Word
$sel:month:CalendarFlags :: CalendarFlags -> Maybe Word
$sel:year:CalendarFlags :: CalendarFlags -> Maybe Word
$sel:text:CalendarFlags :: CalendarFlags -> Maybe Text
..} = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Maybe Text -> (Text -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe Text
text ((Text -> [[Char]]) -> [[Char]]) -> (Text -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \Text
t -> [[Char]
"--text", Text -> [Char]
Text.unpack Text
t]
    , Maybe Word -> (Word -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe Word
year ((Word -> [[Char]]) -> [[Char]]) -> (Word -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \Word
y -> [[Char]
"--year", Word -> [Char]
forall a. Show a => a -> [Char]
show Word
y]
    , Maybe Word -> (Word -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe Word
month ((Word -> [[Char]]) -> [[Char]]) -> (Word -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \Word
m -> [[Char]
"--month", Word -> [Char]
forall a. Show a => a -> [Char]
show Word
m]
    , Maybe Word -> (Word -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe Word
day ((Word -> [[Char]]) -> [[Char]]) -> (Word -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \Word
d -> [[Char]
"--day", Word -> [Char]
forall a. Show a => a -> [Char]
show Word
d]
    ]

-- | Flags for the 'Entry' dialog
--
-- Use 'def' for default flags.
data EntryFlags = EntryFlags
  { EntryFlags -> Maybe Text
text :: Maybe Text -- ^ Dialog text
  , EntryFlags -> Maybe Text
entryText :: Maybe Text -- ^ Entry text
  , EntryFlags -> Bool
hideText :: Bool -- ^ Hide the text entered by the user
  } deriving (EntryFlags -> EntryFlags -> Bool
(EntryFlags -> EntryFlags -> Bool)
-> (EntryFlags -> EntryFlags -> Bool) -> Eq EntryFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntryFlags -> EntryFlags -> Bool
$c/= :: EntryFlags -> EntryFlags -> Bool
== :: EntryFlags -> EntryFlags -> Bool
$c== :: EntryFlags -> EntryFlags -> Bool
Eq, Int -> EntryFlags -> [Char] -> [Char]
[EntryFlags] -> [Char] -> [Char]
EntryFlags -> [Char]
(Int -> EntryFlags -> [Char] -> [Char])
-> (EntryFlags -> [Char])
-> ([EntryFlags] -> [Char] -> [Char])
-> Show EntryFlags
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [EntryFlags] -> [Char] -> [Char]
$cshowList :: [EntryFlags] -> [Char] -> [Char]
show :: EntryFlags -> [Char]
$cshow :: EntryFlags -> [Char]
showsPrec :: Int -> EntryFlags -> [Char] -> [Char]
$cshowsPrec :: Int -> EntryFlags -> [Char] -> [Char]
Show)

instance Default EntryFlags where
  def :: EntryFlags
def = Maybe Text -> Maybe Text -> Bool -> EntryFlags
EntryFlags Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Bool
False

instance CmdParam EntryFlags where
  serializeParam :: EntryFlags -> [[Char]]
serializeParam EntryFlags {Bool
Maybe Text
hideText :: Bool
entryText :: Maybe Text
text :: Maybe Text
$sel:hideText:EntryFlags :: EntryFlags -> Bool
$sel:entryText:EntryFlags :: EntryFlags -> Maybe Text
$sel:text:EntryFlags :: EntryFlags -> Maybe Text
..} = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Maybe Text -> (Text -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe Text
text ((Text -> [[Char]]) -> [[Char]]) -> (Text -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \Text
t -> [[Char]
"--text", Text -> [Char]
Text.unpack Text
t]
    , Maybe Text -> (Text -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe Text
entryText ((Text -> [[Char]]) -> [[Char]]) -> (Text -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \Text
t -> [[Char]
"--entry-text", Text -> [Char]
Text.unpack Text
t]
    , Bool -> [Char] -> [[Char]]
boolParam Bool
hideText [Char]
"--hide-text"
    ]

-- | Flags for the 'FileSelection' dialog
--
-- Use 'def' for default flags.
data FileSelectionFlags = FileSelectionFlags
  { FileSelectionFlags -> Maybe [Char]
fileName :: Maybe FilePath
      -- ^ File or directory to be selected by default
  , FileSelectionFlags -> Bool
directory :: Bool
      -- ^ Activate directory-only selection
  , FileSelectionFlags -> Bool
save :: Bool -- ^ Save mode
  , FileSelectionFlags -> Bool
confirmOverwrite :: Bool
      -- ^ Confirm file selection if file name already exists

  -- TODO , fileFilter :: ???
  } deriving (FileSelectionFlags -> FileSelectionFlags -> Bool
(FileSelectionFlags -> FileSelectionFlags -> Bool)
-> (FileSelectionFlags -> FileSelectionFlags -> Bool)
-> Eq FileSelectionFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSelectionFlags -> FileSelectionFlags -> Bool
$c/= :: FileSelectionFlags -> FileSelectionFlags -> Bool
== :: FileSelectionFlags -> FileSelectionFlags -> Bool
$c== :: FileSelectionFlags -> FileSelectionFlags -> Bool
Eq, Int -> FileSelectionFlags -> [Char] -> [Char]
[FileSelectionFlags] -> [Char] -> [Char]
FileSelectionFlags -> [Char]
(Int -> FileSelectionFlags -> [Char] -> [Char])
-> (FileSelectionFlags -> [Char])
-> ([FileSelectionFlags] -> [Char] -> [Char])
-> Show FileSelectionFlags
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [FileSelectionFlags] -> [Char] -> [Char]
$cshowList :: [FileSelectionFlags] -> [Char] -> [Char]
show :: FileSelectionFlags -> [Char]
$cshow :: FileSelectionFlags -> [Char]
showsPrec :: Int -> FileSelectionFlags -> [Char] -> [Char]
$cshowsPrec :: Int -> FileSelectionFlags -> [Char] -> [Char]
Show)

instance Default FileSelectionFlags where
  def :: FileSelectionFlags
def = Maybe [Char] -> Bool -> Bool -> Bool -> FileSelectionFlags
FileSelectionFlags Maybe [Char]
forall a. Maybe a
Nothing Bool
False Bool
False Bool
False

instance CmdParam FileSelectionFlags where
  serializeParam :: FileSelectionFlags -> [[Char]]
serializeParam FileSelectionFlags {Bool
Maybe [Char]
confirmOverwrite :: Bool
save :: Bool
directory :: Bool
fileName :: Maybe [Char]
$sel:confirmOverwrite:FileSelectionFlags :: FileSelectionFlags -> Bool
$sel:save:FileSelectionFlags :: FileSelectionFlags -> Bool
$sel:directory:FileSelectionFlags :: FileSelectionFlags -> Bool
$sel:fileName:FileSelectionFlags :: FileSelectionFlags -> Maybe [Char]
..} = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Maybe [Char] -> ([Char] -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe [Char]
fileName (([Char] -> [[Char]]) -> [[Char]])
-> ([Char] -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \[Char]
f -> [[Char]
"--filename", [Char]
f]
    , Bool -> [Char] -> [[Char]]
boolParam Bool
directory [Char]
"--directory"
    , Bool -> [Char] -> [[Char]]
boolParam Bool
save [Char]
"--save"
    , Bool -> [Char] -> [[Char]]
boolParam Bool
confirmOverwrite [Char]
"--confirm-overwrite"
    ]

-- | Flags for the 'Error', 'Info', 'Notification' and 'Warning' dialogs
--
-- Note: 'noWrap' and 'noMarkup' have no effect on 'Notification' dialogs.
--
-- Use 'def' for default flags.
data InfoFlags = InfoFlags
  { InfoFlags -> Maybe Text
text :: Maybe Text -- ^ Dialog text
  , InfoFlags -> Bool
noWrap :: Bool -- ^ Do not enable text wrapping
  , InfoFlags -> Bool
noMarkup :: Bool -- ^ Do not enable pango markup
  } deriving (InfoFlags -> InfoFlags -> Bool
(InfoFlags -> InfoFlags -> Bool)
-> (InfoFlags -> InfoFlags -> Bool) -> Eq InfoFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InfoFlags -> InfoFlags -> Bool
$c/= :: InfoFlags -> InfoFlags -> Bool
== :: InfoFlags -> InfoFlags -> Bool
$c== :: InfoFlags -> InfoFlags -> Bool
Eq, Int -> InfoFlags -> [Char] -> [Char]
[InfoFlags] -> [Char] -> [Char]
InfoFlags -> [Char]
(Int -> InfoFlags -> [Char] -> [Char])
-> (InfoFlags -> [Char])
-> ([InfoFlags] -> [Char] -> [Char])
-> Show InfoFlags
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [InfoFlags] -> [Char] -> [Char]
$cshowList :: [InfoFlags] -> [Char] -> [Char]
show :: InfoFlags -> [Char]
$cshow :: InfoFlags -> [Char]
showsPrec :: Int -> InfoFlags -> [Char] -> [Char]
$cshowsPrec :: Int -> InfoFlags -> [Char] -> [Char]
Show)

instance Default InfoFlags where
  def :: InfoFlags
def = Maybe Text -> Bool -> Bool -> InfoFlags
InfoFlags Maybe Text
forall a. Maybe a
Nothing Bool
False Bool
False

instance CmdParam InfoFlags where
  serializeParam :: InfoFlags -> [[Char]]
serializeParam InfoFlags {Bool
Maybe Text
noMarkup :: Bool
noWrap :: Bool
text :: Maybe Text
$sel:noMarkup:InfoFlags :: InfoFlags -> Bool
$sel:noWrap:InfoFlags :: InfoFlags -> Bool
$sel:text:InfoFlags :: InfoFlags -> Maybe Text
..} = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Maybe Text -> (Text -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe Text
text ((Text -> [[Char]]) -> [[Char]]) -> (Text -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \Text
t -> [[Char]
"--text", Text -> [Char]
Text.unpack Text
t]
    , Bool -> [Char] -> [[Char]]
boolParam Bool
noWrap [Char]
"--no-wrap"
    , Bool -> [Char] -> [[Char]]
boolParam Bool
noMarkup [Char]
"--no-markup"
    ]

-- | What column(s) to return in a 'List' dialog
--
-- The default value is @`Col` 1@.
--
-- When 'All' is specified, the columns will be separated by newline characters
-- (@\\n@) in the result.
data ReturnedColumn a
  = All -- ^ Return all columns
  | Col a -- ^ Return the specified column (starting from 1)
  deriving (ReturnedColumn a -> ReturnedColumn a -> Bool
(ReturnedColumn a -> ReturnedColumn a -> Bool)
-> (ReturnedColumn a -> ReturnedColumn a -> Bool)
-> Eq (ReturnedColumn a)
forall a. Eq a => ReturnedColumn a -> ReturnedColumn a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReturnedColumn a -> ReturnedColumn a -> Bool
$c/= :: forall a. Eq a => ReturnedColumn a -> ReturnedColumn a -> Bool
== :: ReturnedColumn a -> ReturnedColumn a -> Bool
$c== :: forall a. Eq a => ReturnedColumn a -> ReturnedColumn a -> Bool
Eq, Int -> ReturnedColumn a -> [Char] -> [Char]
[ReturnedColumn a] -> [Char] -> [Char]
ReturnedColumn a -> [Char]
(Int -> ReturnedColumn a -> [Char] -> [Char])
-> (ReturnedColumn a -> [Char])
-> ([ReturnedColumn a] -> [Char] -> [Char])
-> Show (ReturnedColumn a)
forall a. Show a => Int -> ReturnedColumn a -> [Char] -> [Char]
forall a. Show a => [ReturnedColumn a] -> [Char] -> [Char]
forall a. Show a => ReturnedColumn a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [ReturnedColumn a] -> [Char] -> [Char]
$cshowList :: forall a. Show a => [ReturnedColumn a] -> [Char] -> [Char]
show :: ReturnedColumn a -> [Char]
$cshow :: forall a. Show a => ReturnedColumn a -> [Char]
showsPrec :: Int -> ReturnedColumn a -> [Char] -> [Char]
$cshowsPrec :: forall a. Show a => Int -> ReturnedColumn a -> [Char] -> [Char]
Show, a -> ReturnedColumn b -> ReturnedColumn a
(a -> b) -> ReturnedColumn a -> ReturnedColumn b
(forall a b. (a -> b) -> ReturnedColumn a -> ReturnedColumn b)
-> (forall a b. a -> ReturnedColumn b -> ReturnedColumn a)
-> Functor ReturnedColumn
forall a b. a -> ReturnedColumn b -> ReturnedColumn a
forall a b. (a -> b) -> ReturnedColumn a -> ReturnedColumn b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ReturnedColumn b -> ReturnedColumn a
$c<$ :: forall a b. a -> ReturnedColumn b -> ReturnedColumn a
fmap :: (a -> b) -> ReturnedColumn a -> ReturnedColumn b
$cfmap :: forall a b. (a -> b) -> ReturnedColumn a -> ReturnedColumn b
Functor)

-- | Flags for the 'List' dialog
--
-- Use 'def' for default flags.
data ListFlags = ListFlags
  { ListFlags -> Maybe Text
text :: Maybe Text -- ^ Dialog text
  , ListFlags -> Bool
editable :: Bool -- ^ Allow changes to text
  , ListFlags -> ReturnedColumn Word
returnColumn :: ReturnedColumn Word -- ^ What column(s) to return
  , ListFlags -> Maybe Word
hideColumn :: Maybe Word -- ^ Hide a specific column
  , ListFlags -> Bool
hideHeader :: Bool -- ^ Hide the column headers
  } deriving (ListFlags -> ListFlags -> Bool
(ListFlags -> ListFlags -> Bool)
-> (ListFlags -> ListFlags -> Bool) -> Eq ListFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFlags -> ListFlags -> Bool
$c/= :: ListFlags -> ListFlags -> Bool
== :: ListFlags -> ListFlags -> Bool
$c== :: ListFlags -> ListFlags -> Bool
Eq, Int -> ListFlags -> [Char] -> [Char]
[ListFlags] -> [Char] -> [Char]
ListFlags -> [Char]
(Int -> ListFlags -> [Char] -> [Char])
-> (ListFlags -> [Char])
-> ([ListFlags] -> [Char] -> [Char])
-> Show ListFlags
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [ListFlags] -> [Char] -> [Char]
$cshowList :: [ListFlags] -> [Char] -> [Char]
show :: ListFlags -> [Char]
$cshow :: ListFlags -> [Char]
showsPrec :: Int -> ListFlags -> [Char] -> [Char]
$cshowsPrec :: Int -> ListFlags -> [Char] -> [Char]
Show)

instance Default ListFlags where
  def :: ListFlags
def = Maybe Text
-> Bool -> ReturnedColumn Word -> Maybe Word -> Bool -> ListFlags
ListFlags Maybe Text
forall a. Maybe a
Nothing Bool
False (Word -> ReturnedColumn Word
forall a. a -> ReturnedColumn a
Col Word
1) Maybe Word
forall a. Maybe a
Nothing Bool
False

instance CmdParam ListFlags where
  serializeParam :: ListFlags -> [[Char]]
serializeParam ListFlags {Bool
Maybe Word
Maybe Text
ReturnedColumn Word
hideHeader :: Bool
hideColumn :: Maybe Word
returnColumn :: ReturnedColumn Word
editable :: Bool
text :: Maybe Text
$sel:hideHeader:ListFlags :: ListFlags -> Bool
$sel:hideColumn:ListFlags :: ListFlags -> Maybe Word
$sel:returnColumn:ListFlags :: ListFlags -> ReturnedColumn Word
$sel:editable:ListFlags :: ListFlags -> Bool
$sel:text:ListFlags :: ListFlags -> Maybe Text
..} = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Maybe Text -> (Text -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe Text
text ((Text -> [[Char]]) -> [[Char]]) -> (Text -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \Text
t -> [[Char]
"--text", Text -> [Char]
Text.unpack Text
t]
    , Bool -> [Char] -> [[Char]]
boolParam Bool
editable [Char]
"--editable"
    , case ReturnedColumn Word
returnColumn of
        ReturnedColumn Word
All -> [[Char]
"--print-column", [Char]
"ALL"]
        Col Word
c -> [[Char]
"--print-column", Word -> [Char]
forall a. Show a => a -> [Char]
show Word
c]
    , Maybe Word -> (Word -> [[Char]]) -> [[Char]]
forall a. Maybe a -> (a -> [[Char]]) -> [[Char]]
maybeParam Maybe Word
hideColumn ((Word -> [[Char]]) -> [[Char]]) -> (Word -> [[Char]]) -> [[Char]]
forall a b. (a -> b) -> a -> b
$ \Word
c -> [[Char]
"--hide-column", Word -> [Char]
forall a. Show a => a -> [Char]
show Word
c]
    , Bool -> [Char] -> [[Char]]
boolParam Bool
hideHeader [Char]
"--hide-header"
    ]

-- | Increase the 'returnColumn' option, to cater for the first column in
-- radio/check lists
shiftColumns :: ListFlags -> ListFlags
shiftColumns :: ListFlags -> ListFlags
shiftColumns ListFlags {Bool
Maybe Word
Maybe Text
ReturnedColumn Word
hideHeader :: Bool
hideColumn :: Maybe Word
returnColumn :: ReturnedColumn Word
editable :: Bool
text :: Maybe Text
$sel:hideHeader:ListFlags :: ListFlags -> Bool
$sel:hideColumn:ListFlags :: ListFlags -> Maybe Word
$sel:returnColumn:ListFlags :: ListFlags -> ReturnedColumn Word
$sel:editable:ListFlags :: ListFlags -> Bool
$sel:text:ListFlags :: ListFlags -> Maybe Text
..} = ListFlags :: Maybe Text
-> Bool -> ReturnedColumn Word -> Maybe Word -> Bool -> ListFlags
ListFlags
  { $sel:returnColumn:ListFlags :: ReturnedColumn Word
returnColumn = (Word -> Word) -> ReturnedColumn Word -> ReturnedColumn Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Word
forall p. (Eq p, Num p) => p -> p
shift ReturnedColumn Word
returnColumn
  , $sel:hideColumn:ListFlags :: Maybe Word
hideColumn = (Word -> Word) -> Maybe Word -> Maybe Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Word
forall p. (Eq p, Num p) => p -> p
shift Maybe Word
hideColumn
  , Bool
Maybe Text
hideHeader :: Bool
editable :: Bool
text :: Maybe Text
$sel:hideHeader:ListFlags :: Bool
$sel:editable:ListFlags :: Bool
$sel:text:ListFlags :: Maybe Text
..
  }
  where
    shift :: p -> p
shift p
0 = p
0
    shift p
c = p
cp -> p -> p
forall a. Num a => a -> a -> a
+p
1

-- | Header for the selection column in a radio or check list (can be empty)
newtype SelectionHeader = SelectionHeader {SelectionHeader -> Text
unSelectionHeader :: Text}
  deriving (SelectionHeader -> SelectionHeader -> Bool
(SelectionHeader -> SelectionHeader -> Bool)
-> (SelectionHeader -> SelectionHeader -> Bool)
-> Eq SelectionHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionHeader -> SelectionHeader -> Bool
$c/= :: SelectionHeader -> SelectionHeader -> Bool
== :: SelectionHeader -> SelectionHeader -> Bool
$c== :: SelectionHeader -> SelectionHeader -> Bool
Eq, Int -> SelectionHeader -> [Char] -> [Char]
[SelectionHeader] -> [Char] -> [Char]
SelectionHeader -> [Char]
(Int -> SelectionHeader -> [Char] -> [Char])
-> (SelectionHeader -> [Char])
-> ([SelectionHeader] -> [Char] -> [Char])
-> Show SelectionHeader
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [SelectionHeader] -> [Char] -> [Char]
$cshowList :: [SelectionHeader] -> [Char] -> [Char]
show :: SelectionHeader -> [Char]
$cshow :: SelectionHeader -> [Char]
showsPrec :: Int -> SelectionHeader -> [Char] -> [Char]
$cshowsPrec :: Int -> SelectionHeader -> [Char] -> [Char]
Show, [Char] -> SelectionHeader
([Char] -> SelectionHeader) -> IsString SelectionHeader
forall a. ([Char] -> a) -> IsString a
fromString :: [Char] -> SelectionHeader
$cfromString :: [Char] -> SelectionHeader
IsString)

-- | List dialog type
data ListType a where
  Single :: ListType (Maybe Text)
  Multi :: ListType [Text]
  Radio :: SelectionHeader -> ListType (Maybe Text)
  Check :: SelectionHeader -> ListType [Text]

deriving instance Eq (ListType a)

deriving instance Show (ListType a)

-- | A radio list type with no selection header
radio :: ListType (Maybe Text)
radio :: ListType (Maybe Text)
radio = SelectionHeader -> ListType (Maybe Text)
Radio SelectionHeader
""

-- | A check list type with no selection header
check :: ListType [Text]
check :: ListType [Text]
check = SelectionHeader -> ListType [Text]
Check SelectionHeader
""

-- | The contents of a list dialog
--
-- When used in a dialog, the matrix will be transformed in the following ways:
--
-- * Make sure that the matrix is rectangular and has at least one column and
-- one row. Any headers or elements that are added will be empty strings.
--
-- * Any newline characters will be turned into space characters. (This is
-- because newline characters are used internally as separators when returning
-- multiple rows and/or columns.)
data Matrix = Matrix
  { Matrix -> [Text]
headers :: [Text] -- ^ Column headers
  , Matrix -> [[Text]]
rows :: [[Text]] -- ^ Rows
  } deriving (Matrix -> Matrix -> Bool
(Matrix -> Matrix -> Bool)
-> (Matrix -> Matrix -> Bool) -> Eq Matrix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Matrix -> Matrix -> Bool
$c/= :: Matrix -> Matrix -> Bool
== :: Matrix -> Matrix -> Bool
$c== :: Matrix -> Matrix -> Bool
Eq, Int -> Matrix -> [Char] -> [Char]
[Matrix] -> [Char] -> [Char]
Matrix -> [Char]
(Int -> Matrix -> [Char] -> [Char])
-> (Matrix -> [Char])
-> ([Matrix] -> [Char] -> [Char])
-> Show Matrix
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [Matrix] -> [Char] -> [Char]
$cshowList :: [Matrix] -> [Char] -> [Char]
show :: Matrix -> [Char]
$cshow :: Matrix -> [Char]
showsPrec :: Int -> Matrix -> [Char] -> [Char]
$cshowsPrec :: Int -> Matrix -> [Char] -> [Char]
Show)

-- | Return the width of a 'Matrix' after applying 'fixMatrix' (so the smallest
-- possible value is 1)
matrixWidth :: Matrix -> Int
matrixWidth :: Matrix -> Int
matrixWidth Matrix {[[Text]]
[Text]
rows :: [[Text]]
headers :: [Text]
$sel:rows:Matrix :: Matrix -> [[Text]]
$sel:headers:Matrix :: Matrix -> [Text]
..} = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
headers) ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ([Text] -> Int) -> [[Text]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Text]]
rows)

-- | Make sure that the matrix is rectangular and has at least one column and
-- one row. Any headers or elements that are added will be empty strings.
--
-- The main reason for requring a non-empty matrix is that Zenity gives the
-- result @"(null)"@ otherwise. Not using empty matrices avoids the need to
-- handle such results.
fixMatrix :: Matrix -> Matrix
fixMatrix :: Matrix -> Matrix
fixMatrix mat :: Matrix
mat@Matrix {[[Text]]
[Text]
rows :: [[Text]]
headers :: [Text]
$sel:rows:Matrix :: Matrix -> [[Text]]
$sel:headers:Matrix :: Matrix -> [Text]
..} = Matrix :: [Text] -> [[Text]] -> Matrix
Matrix
  { $sel:headers:Matrix :: [Text]
headers = [Text] -> [Text]
widen ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
headers then [Text
""] else [Text]
headers
  , $sel:rows:Matrix :: [[Text]]
rows = ([Text] -> [Text]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map [Text] -> [Text]
widen ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ if [[Text]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Text]]
rows then [[]] else [[Text]]
rows
  }
  where
    width :: Int
width = Matrix -> Int
matrixWidth Matrix
mat
    widen :: [Text] -> [Text]
widen [Text]
as = [Text]
as [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
n Text
""
      where
        n :: Int
n = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
as

-- | Add a first column for 'Radio' or 'Check' lists
addSelectionColumn :: SelectionHeader -> Matrix -> Matrix
addSelectionColumn :: SelectionHeader -> Matrix -> Matrix
addSelectionColumn SelectionHeader
hdr Matrix
mat = Matrix :: [Text] -> [[Text]] -> Matrix
Matrix
  { $sel:headers:Matrix :: [Text]
headers = SelectionHeader -> Text
unSelectionHeader SelectionHeader
hdr Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
headers
  , $sel:rows:Matrix :: [[Text]]
rows = ([Text] -> [Text]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (Text
"" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) [[Text]]
rows
  }
  where
    Matrix {[[Text]]
[Text]
rows :: [[Text]]
headers :: [Text]
$sel:rows:Matrix :: Matrix -> [[Text]]
$sel:headers:Matrix :: Matrix -> [Text]
..} = Matrix -> Matrix
fixMatrix Matrix
mat
      -- Need to apply `fixMatrix` before adding the column. It doesn't matter
      -- that `fixMatrix` will be applied again inside `matrixFlags`.

matrixFlags :: Matrix -> [String]
matrixFlags :: Matrix -> [[Char]]
matrixFlags Matrix
mat = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ (Text -> [[Char]]) -> [Text] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Text
hdr -> [[Char]
"--column", Text -> [Char]
Text.unpack Text
hdr]) [Text]
headers
  , ([Text] -> [[Char]]) -> [[Text]] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
convertNewline ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack)) [[Text]]
rows
  ]
  where
    Matrix {[[Text]]
[Text]
rows :: [[Text]]
headers :: [Text]
$sel:rows:Matrix :: Matrix -> [[Text]]
$sel:headers:Matrix :: Matrix -> [Text]
..} = Matrix -> Matrix
fixMatrix Matrix
mat
    convertNewline :: Char -> Char
convertNewline Char
'\n' = Char
' '
    convertNewline Char
c = Char
c

-- | Zenity commands
--
-- Things to be aware of:
--
-- * In the very unlikely case of a file name containing newline characters,
-- 'MultiFileSelection' will give an incorrect result. This is because it uses
-- @\\n@ to separate the files returned from Zenity.
data Dialog a where
  Calendar :: CalendarFlags -> Dialog (Maybe Day)
  Entry :: EntryFlags -> Dialog (Maybe Text)
  Error :: InfoFlags -> Dialog ()
  FileSelection :: FileSelectionFlags -> Dialog (Maybe FilePath)
  MultiFileSelection :: FileSelectionFlags -> Dialog [FilePath]
  Info :: InfoFlags -> Dialog ()
  List :: ListType a -> ListFlags -> Matrix -> Dialog a
  Notification :: InfoFlags -> Dialog ()
  Warning :: InfoFlags -> Dialog ()
  -- TODO:
  -- Progress
  -- Question
  -- TextInfo
  -- Scale
  -- ColorSelection
  -- Password
  -- Forms

-- | Call Zenity with the given flags and capture its 'stdout'
callZenity ::
     Config
  -> [String] -- ^ Additional command-line flags
  -> IO Text
callZenity :: Config -> [[Char]] -> IO Text
callZenity Config
cfg [[Char]]
flags = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
debug Config
cfg) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
showCommandForUser [Char]
"zenity" [[Char]]
flags'
  (\(ExitCode
_, Text
o, Text
_) -> Text
o) ((ExitCode, Text, Text) -> Text)
-> IO (ExitCode, Text, Text) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> Text -> IO (ExitCode, Text, Text)
Text.readProcessWithExitCode [Char]
"zenity" [[Char]]
flags' Text
""
  where
    flags' :: [[Char]]
flags' = Config -> [[Char]]
configFlags Config
cfg [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
flags

parseResult :: Text -> Maybe Text
parseResult :: Text -> Maybe Text
parseResult Text
"" = Maybe Text
forall a. Maybe a
Nothing
  -- If the user entered an empty string, "\n" will be returned
parseResult Text
t = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
t

dateFormat :: p
dateFormat = p
"%Y-%m-%d"

readDay :: MonadFail m => Text -> m Day
readDay :: Text -> m Day
readDay = Bool -> TimeLocale -> [Char] -> [Char] -> m Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> [Char] -> [Char] -> m t
parseTimeM Bool
False TimeLocale
defaultTimeLocale [Char]
forall p. IsString p => p
dateFormat ([Char] -> m Day) -> (Text -> [Char]) -> Text -> m Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack

-- | If @`returnColumn` = All@, this function will treat the input list as a
-- concated list of elements from selected rows, and turn that into a list of
-- selected rows. Each row in the result is represented as a single 'Text' value
-- with elements separated by newline characters (@\\n@).
--
-- The 'Matrix' argument is just used to determine the number of returned
-- columns (the width of the matrix).
--
-- If @`returnColumn` = Col c@, the argument list is returned unchanged.
unconcat ::
     ListFlags
  -> Matrix
  -> [Text] -- ^ Concated elements from selected rows
  -> [Text] -- ^ Selected rows
unconcat :: ListFlags -> Matrix -> [Text] -> [Text]
unconcat ListFlags {Bool
Maybe Word
Maybe Text
ReturnedColumn Word
hideHeader :: Bool
hideColumn :: Maybe Word
returnColumn :: ReturnedColumn Word
editable :: Bool
text :: Maybe Text
$sel:hideHeader:ListFlags :: ListFlags -> Bool
$sel:hideColumn:ListFlags :: ListFlags -> Maybe Word
$sel:returnColumn:ListFlags :: ListFlags -> ReturnedColumn Word
$sel:editable:ListFlags :: ListFlags -> Bool
$sel:text:ListFlags :: ListFlags -> Maybe Text
..} Matrix
mat
  | ReturnedColumn Word
All <- ReturnedColumn Word
returnColumn =
    ([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Text -> Text
Text.dropEnd Int
1 (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
Text.unlines) ([[Text]] -> [Text]) -> ([Text] -> [[Text]]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [[Text]]
forall a. Int -> [a] -> [[a]]
chunk (Matrix -> Int
matrixWidth Matrix
mat)
  | Bool
otherwise = [Text] -> [Text]
forall a. a -> a
id

-- | Run a 'Dialog' action
zenity :: Config -> Dialog a -> IO a
zenity :: Config -> Dialog a -> IO a
zenity Config
cfg (Calendar CalendarFlags
flags) =
  (Text -> IO Day) -> Maybe Text -> IO (Maybe Day)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> IO Day
forall (m :: * -> *). MonadFail m => Text -> m Day
readDay (Maybe Text -> IO (Maybe Day))
-> (Text -> Maybe Text) -> Text -> IO (Maybe Day)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
parseResult (Text -> IO (Maybe Day)) -> IO Text -> IO (Maybe Day)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
  Config -> [[Char]] -> IO Text
callZenity
    Config
cfg
    ([Char]
"--calendar" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ([Char]
"--date-format=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
forall p. IsString p => p
dateFormat) [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: CalendarFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam CalendarFlags
flags)
zenity Config
cfg (Entry EntryFlags
flags) =
  (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
parseResult (IO Text -> IO (Maybe Text)) -> IO Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Config -> [[Char]] -> IO Text
callZenity Config
cfg ([Char]
"--entry" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: EntryFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam EntryFlags
flags)
zenity Config
cfg (Error InfoFlags
flags) =
  IO Text -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Text -> IO ()) -> IO Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$ [Char]
"--error" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: InfoFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam InfoFlags
flags
zenity Config
cfg (FileSelection FileSelectionFlags
flags) =
  (Text -> Maybe [Char]) -> IO Text -> IO (Maybe [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> [Char]) -> Maybe Text -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Char]
Text.unpack (Maybe Text -> Maybe [Char])
-> (Text -> Maybe Text) -> Text -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
parseResult) (IO Text -> IO (Maybe [Char])) -> IO Text -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$
  Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$ [Char]
"--file-selection" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: FileSelectionFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam FileSelectionFlags
flags
zenity Config
cfg (MultiFileSelection FileSelectionFlags
flags) =
  (Text -> [[Char]]) -> IO Text -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> [[Char]]
lines ([Char] -> [[Char]]) -> (Text -> [Char]) -> Text -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack) (IO Text -> IO [[Char]]) -> IO Text -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$
  Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$
  [Char]
"--file-selection" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  [Char]
"--multiple" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
"--separator" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
"\n" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: FileSelectionFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam FileSelectionFlags
flags
zenity Config
cfg (Info InfoFlags
flags) =
  IO Text -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Text -> IO ()) -> IO Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$ [Char]
"--info" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: InfoFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam InfoFlags
flags
zenity Config
cfg (List ListType a
Single ListFlags
flags Matrix
mat) =
  (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
parseResult (IO Text -> IO (Maybe Text)) -> IO Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$
  Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$
  [Char]
"--list" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
"--separator" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
"\n" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ListFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam ListFlags
flags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Matrix -> [[Char]]
matrixFlags Matrix
mat
zenity Config
cfg (List ListType a
Multi ListFlags
flags Matrix
mat) =
  (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListFlags -> Matrix -> [Text] -> [Text]
unconcat ListFlags
flags Matrix
mat ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines) (IO Text -> IO [Text]) -> IO Text -> IO [Text]
forall a b. (a -> b) -> a -> b
$
  Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$
  [Char]
"--list" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  [Char]
"--separator" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
"\n" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [Char]
"--multiple" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: ListFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam ListFlags
flags [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Matrix -> [[Char]]
matrixFlags Matrix
mat
zenity Config
cfg (List (Radio SelectionHeader
h) ListFlags
flags Matrix
mat) =
  (Text -> Maybe Text) -> IO Text -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
parseResult (IO Text -> IO (Maybe Text)) -> IO Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$
  Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$
  [Char]
"--list" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  [Char]
"--separator" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  [Char]
"\n" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  [Char]
"--radiolist" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  ListFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam (ListFlags -> ListFlags
shiftColumns ListFlags
flags) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Matrix -> [[Char]]
matrixFlags (SelectionHeader -> Matrix -> Matrix
addSelectionColumn SelectionHeader
h Matrix
mat)
zenity Config
cfg (List (Check SelectionHeader
h) ListFlags
flags Matrix
mat) =
  (Text -> [Text]) -> IO Text -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ListFlags -> Matrix -> [Text] -> [Text]
unconcat ListFlags
flags Matrix
mat ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.lines) (IO Text -> IO [Text]) -> IO Text -> IO [Text]
forall a b. (a -> b) -> a -> b
$
  Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$
  [Char]
"--list" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  [Char]
"--separator" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  [Char]
"\n" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  [Char]
"--checklist" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:
  ListFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam (ListFlags -> ListFlags
shiftColumns ListFlags
flags) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ Matrix -> [[Char]]
matrixFlags (SelectionHeader -> Matrix -> Matrix
addSelectionColumn SelectionHeader
h Matrix
mat)
zenity Config
cfg (Notification InfoFlags
flags) =
  IO Text -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Text -> IO ()) -> IO Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$ [Char]
"--notification" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: InfoFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam InfoFlags
flags'
  where
    flags' :: InfoFlags
flags' = InfoFlags
flags {$sel:noWrap:InfoFlags :: Bool
noWrap = Bool
False, $sel:noMarkup:InfoFlags :: Bool
noMarkup = Bool
False}
zenity Config
cfg (Warning InfoFlags
flags) =
  IO Text -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Text -> IO ()) -> IO Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> [[Char]] -> IO Text
callZenity Config
cfg ([[Char]] -> IO Text) -> [[Char]] -> IO Text
forall a b. (a -> b) -> a -> b
$ [Char]
"--warning" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: InfoFlags -> [[Char]]
forall p. CmdParam p => p -> [[Char]]
serializeParam InfoFlags
flags



----------------------------------------
-- ** Extra dialogs
----------------------------------------

-- | Make a list selection dialog that selects values from an association list
--
-- Each item is a pair of a value of type @a@ and a text. Only the text will be
-- shown in the dialog, but the value associated with the selected text will be
-- returned.
keyedList ::
     (Show a, Read a, Functor f)
  => Config
  -> ListType (f Text)
  -> ListFlags -- ^ @returnColumn@ and @hideColumn@ will be ignored
  -> Text -- ^ Column head (can be empty)
  -> [(a, Text)] -- ^ List to select from
  -> IO (f a)
keyedList :: Config
-> ListType (f Text)
-> ListFlags
-> Text
-> [(a, Text)]
-> IO (f a)
keyedList Config
cfg ListType (f Text)
ltype ListFlags
flags Text
hd [(a, Text)]
as =
  (f Text -> f a) -> IO (f Text) -> IO (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> a) -> f Text -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> a
forall a. Read a => [Char] -> a
read ([Char] -> a) -> (Text -> [Char]) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack)) (IO (f Text) -> IO (f a)) -> IO (f Text) -> IO (f a)
forall a b. (a -> b) -> a -> b
$
  Config -> Dialog (f Text) -> IO (f Text)
forall a. Config -> Dialog a -> IO a
zenity Config
cfg (Dialog (f Text) -> IO (f Text)) -> Dialog (f Text) -> IO (f Text)
forall a b. (a -> b) -> a -> b
$
  ListType (f Text) -> ListFlags -> Matrix -> Dialog (f Text)
forall a. ListType a -> ListFlags -> Matrix -> Dialog a
List ListType (f Text)
ltype ListFlags
flags {$sel:returnColumn:ListFlags :: ReturnedColumn Word
returnColumn = Word -> ReturnedColumn Word
forall a. a -> ReturnedColumn a
Col Word
1, $sel:hideColumn:ListFlags :: Maybe Word
hideColumn = Word -> Maybe Word
forall a. a -> Maybe a
Just Word
1} (Matrix -> Dialog (f Text)) -> Matrix -> Dialog (f Text)
forall a b. (a -> b) -> a -> b
$
  Matrix :: [Text] -> [[Text]] -> Matrix
Matrix
  {$sel:headers:Matrix :: [Text]
headers = [Text
"", Text
hd], $sel:rows:Matrix :: [[Text]]
rows = [[[Char] -> Text
Text.pack (a -> [Char]
forall a. Show a => a -> [Char]
show a
a), Text
txt] | (a
a, Text
txt) <- [(a, Text)]
as]}