{-# LANGUAGE RecordWildCards, TypeSynonymInstances, FlexibleInstances #-}

-- | Module for implementing CmdArgs helpers. A CmdArgs helper is an external program,
--   that helps a user construct the command line arguments. To use a helper set the
--   environment variable @$CMDARGS_HELPER@ (or @$CMDARGS_HELPER_/YOURPROGRAM/@) to
--   one of:
--
-- * @echo /foo/@ will cause @/foo/@ to be used as the command arguments.
--
-- * @cmdargs-browser@ will cause a web browser to appear to help entering the arguments.
--   For this command to work, you will need to install the @cmdargs-browser@ package:
--   <http://hackage.haskell.org/package/cmdargs-browser>
module System.Console.CmdArgs.Helper(
    -- * Called by the main program
    execute,
    -- * Called by the helper program
    Unknown, receive, reply, comment
    ) where
-- Should really be under Explicit, but want to export it top-level as Helper

import System.Console.CmdArgs.Explicit.Type
import System.Console.CmdArgs.Explicit.SplitJoin
import System.Process
import Control.Exception
import Control.Monad
import Data.Char
import Data.IORef
import Data.List
import Data.Maybe
import System.Exit
import System.IO
import System.IO.Unsafe


hOut :: Handle -> String -> IO ()
hOut Handle
h String
x = do
    Handle -> String -> IO ()
hPutStrLn Handle
h String
x
    Handle -> IO ()
hFlush Handle
h


-- | Run a remote command line entry.
execute
    :: String -- ^ Name of the command to run, e.g. @echo argument@, @cmdargs-browser@
    -> Mode a -- ^ Mode to run remotely
    -> [String] -- ^ Initial set of command line flags (not supported by all helpers)
    -> IO (Either String [String]) -- ^ Either an error message, or a list of flags to use
execute :: forall a.
String -> Mode a -> [String] -> IO (Either String [String])
execute String
cmd Mode a
mode [String]
args
    | String
"echo" forall a. Eq a => a -> a -> Bool
== forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
cmd = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> [String]
splitArgs forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
4 String
cmd
    | Bool
otherwise = forall {c}. Handle -> BufferMode -> IO c -> IO c
withBuffering Handle
stdout BufferMode
NoBuffering forall a b. (a -> b) -> a -> b
$ do
        (Just Handle
hin, Just Handle
hout, Maybe Handle
_, ProcessHandle
_) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> CreateProcess
shell String
cmd){std_in :: StdStream
std_in=StdStream
CreatePipe, std_out :: StdStream
std_out=StdStream
CreatePipe}
        -- none of the buffering seems necessary in practice, but better safe than sorry
        Handle -> BufferMode -> IO ()
hSetBuffering Handle
hin BufferMode
LineBuffering
        Handle -> BufferMode -> IO ()
hSetBuffering Handle
hout BufferMode
LineBuffering
        (String
m, String -> IO String
ans) <- forall a. Mode a -> IO (String, String -> IO String)
saveMode Mode a
mode
        Handle -> String -> IO ()
hOut Handle
hin String
m
        forall {b}.
Read b =>
(String -> IO String) -> Handle -> Handle -> IO (Either String b)
loop String -> IO String
ans Handle
hin Handle
hout
    where
        loop :: (String -> IO String) -> Handle -> Handle -> IO (Either String b)
loop String -> IO String
ans Handle
hin Handle
hout = do
            String
x <- Handle -> IO String
hGetLine Handle
hout
            if String
"Result " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
7 String
x
             else if String
"Send " forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then do
                Handle -> String -> IO ()
hOut Handle
hin forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
ans (forall a. Int -> [a] -> [a]
drop Int
5 String
x)
                (String -> IO String) -> Handle -> Handle -> IO (Either String b)
loop String -> IO String
ans Handle
hin Handle
hout
             else if String
"#" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then do
                Handle -> String -> IO ()
hOut Handle
stdout String
x
                (String -> IO String) -> Handle -> Handle -> IO (Either String b)
loop String -> IO String
ans Handle
hin Handle
hout
             else
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Unexpected message from program: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
x


withBuffering :: Handle -> BufferMode -> IO c -> IO c
withBuffering Handle
hndl BufferMode
mode IO c
act = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    (do BufferMode
old <- Handle -> IO BufferMode
hGetBuffering Handle
hndl; Handle -> BufferMode -> IO ()
hSetBuffering Handle
hndl BufferMode
mode; forall (m :: * -> *) a. Monad m => a -> m a
return BufferMode
old)
    (Handle -> BufferMode -> IO ()
hSetBuffering Handle
hndl)
    (forall a b. a -> b -> a
const IO c
act)


-- | Unknown value, representing the values stored within the 'Mode' structure. While the values
--   are not observable, they behave identically to the original values.
newtype Unknown = Unknown {Unknown -> Value
fromUnknown :: Value} -- wrap Value so the Pack instance doesn't leak


-- | Receive information about the mode to display.
receive :: IO (Mode Unknown)
receive :: IO (Mode Unknown)
receive = do
    String
m <- IO String
getLine
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> a) -> m a -> m b
remap2 Value -> Unknown
Unknown Unknown -> Value
fromUnknown forall a b. (a -> b) -> a -> b
$ String -> (String -> String) -> Mode Value
loadMode String
m forall a b. (a -> b) -> a -> b
$ \String
msg -> forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
        Handle -> String -> IO ()
hOut Handle
stdout forall a b. (a -> b) -> a -> b
$ String
"Send " forall a. [a] -> [a] -> [a]
++ String
msg
        IO String
getLine


-- | Send a reply with either an error, or a list of flags to use. This function exits the helper program.
reply :: Either String [String] -> IO ()
reply :: Either String [String] -> IO ()
reply Either String [String]
x = do
    Handle -> String -> IO ()
hOut Handle
stdout forall a b. (a -> b) -> a -> b
$ String
"Result " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Either String [String]
x
    forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess


-- | Send a comment which will be displayed on the calling console, mainly useful for debugging.
comment :: String -> IO ()
comment :: String -> IO ()
comment String
x = Handle -> String -> IO ()
hOut Handle
stdout forall a b. (a -> b) -> a -> b
$ String
"# " forall a. [a] -> [a] -> [a]
++ String
x


---------------------------------------------------------------------
-- IO MAP

data IOMap a = IOMap (IORef (Int,[(Int,a)]))

newIOMap :: IO (IOMap a)
newIOMap :: forall a. IO (IOMap a)
newIOMap = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IORef (Int, [(Int, a)]) -> IOMap a
IOMap forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef (Int
0, [])

addIOMap :: IOMap a -> a -> IO Int
addIOMap :: forall a. IOMap a -> a -> IO Int
addIOMap (IOMap IORef (Int, [(Int, a)])
ref) a
x = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Int, [(Int, a)])
ref forall a b. (a -> b) -> a -> b
$ \(Int
i,[(Int, a)]
xs) -> let j :: Int
j = Int
iforall a. Num a => a -> a -> a
+Int
1 in ((Int
j,(Int
j,a
x)forall a. a -> [a] -> [a]
:[(Int, a)]
xs), Int
j)

getIOMap :: IOMap a -> Int -> IO a
getIOMap :: forall a. IOMap a -> Int -> IO a
getIOMap (IOMap IORef (Int, [(Int, a)])
ref) Int
i = do (Int
_,[(Int, a)]
xs) <- forall a. IORef a -> IO a
readIORef IORef (Int, [(Int, a)])
ref; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, a)]
xs


---------------------------------------------------------------------
-- SERIALISE A MODE

newtype Value = Value Int


{-# NOINLINE toValue #-}
toValue :: Mode a -> Mode Value
-- fairly safe, use of a table and pointers from one process to another, but referentially transparent
toValue :: forall a. Mode a -> Mode Value
toValue Mode a
x = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    -- the ref accumulates, so is a space leak
    -- but it will all disappear after the helper goes, so not too much of an issue
    IOMap a
mp <- forall a. IO (IOMap a)
newIOMap
    let embed :: a -> Value
embed a
x = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Value
Value forall a b. (a -> b) -> a -> b
$ forall a. IOMap a -> a -> IO Int
addIOMap IOMap a
mp a
x
        proj :: Value -> a
proj (Value Int
x) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. IOMap a -> Int -> IO a
getIOMap IOMap a
mp Int
x
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> a) -> m a -> m b
remap2 a -> Value
embed Value -> a
proj Mode a
x


saveMode :: Mode a -> IO (String, String -> IO String) -- (value, ask questions from stdin)
saveMode :: forall a. Mode a -> IO (String, String -> IO String)
saveMode Mode a
m = do
    IOMap (Pack -> Pack)
mp <- forall a. IO (IOMap a)
newIOMap
    Pack
res <- IOMap (Pack -> Pack) -> Pack -> IO Pack
add IOMap (Pack -> Pack)
mp forall a b. (a -> b) -> a -> b
$ forall a. Packer a => a -> Pack
pack forall a b. (a -> b) -> a -> b
$ forall a. Mode a -> Mode Value
toValue Mode a
m
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. Show a => a -> String
show Pack
res, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOMap (Pack -> Pack) -> (Int, Pack) -> IO Pack
get IOMap (Pack -> Pack)
mp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> a
read)
    where
        add :: IOMap (Pack -> Pack) -> Pack -> IO Pack
        add :: IOMap (Pack -> Pack) -> Pack -> IO Pack
add IOMap (Pack -> Pack)
mp Pack
x = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *). Monad m => (Pack -> m Pack) -> Pack -> m Pack
transformM Pack
x forall a b. (a -> b) -> a -> b
$ \Pack
x -> case Pack
x of
            Func (NoShow Pack -> Pack
f) -> do Int
i <- forall a. IOMap a -> a -> IO Int
addIOMap IOMap (Pack -> Pack)
mp Pack -> Pack
f; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Pack
FuncId Int
i
            Pack
x -> forall (m :: * -> *) a. Monad m => a -> m a
return Pack
x

        get :: IOMap (Pack -> Pack) -> (Int,Pack) -> IO Pack
        get :: IOMap (Pack -> Pack) -> (Int, Pack) -> IO Pack
get IOMap (Pack -> Pack)
mp (Int
i,Pack
x) = do
            Pack -> Pack
f <- forall a. IOMap a -> Int -> IO a
getIOMap IOMap (Pack -> Pack)
mp Int
i
            IOMap (Pack -> Pack) -> Pack -> IO Pack
add IOMap (Pack -> Pack)
mp forall a b. (a -> b) -> a -> b
$ Pack -> Pack
f Pack
x


loadMode :: String -> (String -> String) -> Mode Value -- given serialised, question asker, give me a value
loadMode :: String -> (String -> String) -> Mode Value
loadMode String
x String -> String
f = forall a. Packer a => Pack -> a
unpack forall a b. (a -> b) -> a -> b
$ Pack -> Pack
rep forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
x
    where
        rep :: Pack -> Pack
        rep :: Pack -> Pack
rep Pack
x = forall a b c. (a -> b -> c) -> b -> a -> c
flip (Pack -> Pack) -> Pack -> Pack
transform Pack
x forall a b. (a -> b) -> a -> b
$ \Pack
x -> case Pack
x of
            FuncId Int
i -> NoShow (Pack -> Pack) -> Pack
Func forall a b. (a -> b) -> a -> b
$ forall a. a -> NoShow a
NoShow forall a b. (a -> b) -> a -> b
$ \Pack
y -> Pack -> Pack
rep forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ String -> String
f forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (Int
i,Pack
y)
            Pack
x -> Pack
x


-- Support data types

data Pack = Ctor String [(String, Pack)]
          | List [Pack]
          | Char Char
          | Int Int
          | Func (NoShow (Pack -> Pack))
          | FuncId Int -- Never passed to pack/unpack, always transfromed away by saveMode/loadMode
          | String String
          | None -- ^ Never generated, only used for reading in bad cases
            deriving (Int -> Pack -> String -> String
[Pack] -> String -> String
Pack -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Pack] -> String -> String
$cshowList :: [Pack] -> String -> String
show :: Pack -> String
$cshow :: Pack -> String
showsPrec :: Int -> Pack -> String -> String
$cshowsPrec :: Int -> Pack -> String -> String
Show,ReadPrec [Pack]
ReadPrec Pack
Int -> ReadS Pack
ReadS [Pack]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Pack]
$creadListPrec :: ReadPrec [Pack]
readPrec :: ReadPrec Pack
$creadPrec :: ReadPrec Pack
readList :: ReadS [Pack]
$creadList :: ReadS [Pack]
readsPrec :: Int -> ReadS Pack
$creadsPrec :: Int -> ReadS Pack
Read)

newtype NoShow a = NoShow a
instance Show (NoShow a) where showsPrec :: Int -> NoShow a -> String -> String
showsPrec = forall a. HasCallStack => String -> a
error String
"Cannot show value of type NoShow"
instance Read (NoShow a) where readsPrec :: Int -> ReadS (NoShow a)
readsPrec = forall a. HasCallStack => String -> a
error String
"Cannot read value of type NoShow"


transformM, descendM :: Monad m => (Pack -> m Pack) -> Pack -> m Pack
transformM :: forall (m :: * -> *). Monad m => (Pack -> m Pack) -> Pack -> m Pack
transformM Pack -> m Pack
f Pack
x = Pack -> m Pack
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). Monad m => (Pack -> m Pack) -> Pack -> m Pack
descendM (forall (m :: * -> *). Monad m => (Pack -> m Pack) -> Pack -> m Pack
transformM Pack -> m Pack
f) Pack
x
descendM :: forall (m :: * -> *). Monad m => (Pack -> m Pack) -> Pack -> m Pack
descendM Pack -> m Pack
f Pack
x = let ([Pack]
a,[Pack] -> Pack
b) = Pack -> ([Pack], [Pack] -> Pack)
uniplate Pack
x in forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Pack] -> Pack
b forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Pack -> m Pack
f [Pack]
a

transform, descend :: (Pack -> Pack) -> Pack -> Pack
transform :: (Pack -> Pack) -> Pack -> Pack
transform Pack -> Pack
f = Pack -> Pack
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pack -> Pack) -> Pack -> Pack
descend ((Pack -> Pack) -> Pack -> Pack
transform Pack -> Pack
f)
descend :: (Pack -> Pack) -> Pack -> Pack
descend Pack -> Pack
f Pack
x = let ([Pack]
a,[Pack] -> Pack
b) = Pack -> ([Pack], [Pack] -> Pack)
uniplate Pack
x in [Pack] -> Pack
b forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Pack -> Pack
f [Pack]
a

uniplate :: Pack -> ([Pack], [Pack] -> Pack)
uniplate :: Pack -> ([Pack], [Pack] -> Pack)
uniplate (List [Pack]
xs) = ([Pack]
xs, [Pack] -> Pack
List)
uniplate (Ctor String
x [(String, Pack)]
ys) = (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(String, Pack)]
ys, String -> [(String, Pack)] -> Pack
Ctor String
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Pack)]
ys))
uniplate Pack
x = ([], forall a b. a -> b -> a
const Pack
x)


class Packer a where
    pack :: a -> Pack
    unpack :: Pack -> a

add :: a -> a -> (a, Pack)
add a
a a
b = (a
a, forall a. Packer a => a -> Pack
pack a
b)
ctor :: String -> Pack -> [(String, Pack)]
ctor String
x (Ctor String
y [(String, Pack)]
xs) | String
x forall a. Eq a => a -> a -> Bool
== String
y = [(String, Pack)]
xs
ctor String
_ Pack
_ = []
get :: a -> [(a, Pack)] -> a
get a
a [(a, Pack)]
b = forall a. Packer a => Pack -> a
unpack forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Pack
None forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
a [(a, Pack)]
b


-- General instances

instance Packer a => Packer [a] where
    pack :: [a] -> Pack
pack [a]
xs = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pack]
ys forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length String
zs Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pack]
ys) then String -> Pack
String String
zs else [Pack] -> Pack
List [Pack]
ys
        where ys :: [Pack]
ys = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Packer a => a -> Pack
pack) [a]
xs
              zs :: String
zs = [Char
x | Char Char
x <- [Pack]
ys]

    unpack :: Pack -> [a]
unpack (String String
xs) = forall a. Packer a => Pack -> a
unpack forall a b. (a -> b) -> a -> b
$ [Pack] -> Pack
List forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Char -> Pack
Char String
xs
    unpack (List [Pack]
xs) = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Packer a => Pack -> a
unpack) [Pack]
xs
    unpack Pack
_ = []

instance (Packer a, Packer b) => Packer (a -> b) where
    pack :: (a -> b) -> Pack
pack a -> b
f = NoShow (Pack -> Pack) -> Pack
Func forall a b. (a -> b) -> a -> b
$ forall a. a -> NoShow a
NoShow forall a b. (a -> b) -> a -> b
$ forall a. Packer a => a -> Pack
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Packer a => Pack -> a
unpack
    unpack :: Pack -> a -> b
unpack (Func (NoShow Pack -> Pack
f)) = forall a. Packer a => Pack -> a
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pack -> Pack
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Packer a => a -> Pack
pack

instance Packer Value where
    pack :: Value -> Pack
pack (Value Int
x) = forall a. Packer a => a -> Pack
pack Int
x
    unpack :: Pack -> Value
unpack Pack
x = Int -> Value
Value forall a b. (a -> b) -> a -> b
$ forall a. Packer a => Pack -> a
unpack Pack
x

instance Packer Char where
    pack :: Char -> Pack
pack = Char -> Pack
Char
    unpack :: Pack -> Char
unpack (Char Char
x) = Char
x
    unpack Pack
_ = Char
' '

instance Packer Int where
    pack :: Int -> Pack
pack = Int -> Pack
Int
    unpack :: Pack -> Int
unpack (Int Int
x) = Int
x
    unpack Pack
_ = -Int
1

instance (Packer a, Packer b) => Packer (a,b) where
    pack :: (a, b) -> Pack
pack (a
a,b
b) = String -> [(String, Pack)] -> Pack
Ctor String
"(,)" [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"fst" a
a, forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"snd" b
b]
    unpack :: Pack -> (a, b)
unpack Pack
x = (forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fst" [(String, Pack)]
y, forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"snd" [(String, Pack)]
y)
        where y :: [(String, Pack)]
y = String -> Pack -> [(String, Pack)]
ctor String
"(,)" Pack
x

instance Packer a => Packer (Maybe a) where
    pack :: Maybe a -> Pack
pack Maybe a
Nothing = String -> [(String, Pack)] -> Pack
Ctor String
"Nothing" []
    pack (Just a
x) = String -> [(String, Pack)] -> Pack
Ctor String
"Just" [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"fromJust" a
x]
    unpack :: Pack -> Maybe a
unpack x :: Pack
x@(Ctor String
"Just" [(String, Pack)]
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromJust" forall a b. (a -> b) -> a -> b
$ String -> Pack -> [(String, Pack)]
ctor String
"Just" Pack
x
    unpack Pack
_ = forall a. Maybe a
Nothing

instance (Packer a, Packer b) => Packer (Either a b) where
    pack :: Either a b -> Pack
pack (Left a
x) = String -> [(String, Pack)] -> Pack
Ctor String
"Left" [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"fromLeft" a
x]
    pack (Right b
x) = String -> [(String, Pack)] -> Pack
Ctor String
"Right" [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"fromRight" b
x]
    unpack :: Pack -> Either a b
unpack x :: Pack
x@(Ctor String
"Left" [(String, Pack)]
_) = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromLeft" forall a b. (a -> b) -> a -> b
$ String -> Pack -> [(String, Pack)]
ctor String
"Left" Pack
x
    unpack x :: Pack
x@(Ctor String
"Right" [(String, Pack)]
_) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromRight" forall a b. (a -> b) -> a -> b
$ String -> Pack -> [(String, Pack)]
ctor String
"Right" Pack
x
    unpack Pack
_ = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Packer a => Pack -> a
unpack Pack
None

instance Packer Bool where
    pack :: Bool -> Pack
pack Bool
True = String -> [(String, Pack)] -> Pack
Ctor String
"True" []
    pack Bool
_ = String -> [(String, Pack)] -> Pack
Ctor String
"False" []
    unpack :: Pack -> Bool
unpack (Ctor String
"True" [(String, Pack)]
_) = Bool
True
    unpack Pack
_ = Bool
False


-- CmdArgs specific

instance Packer a => Packer (Group a) where
    pack :: Group a -> Pack
pack Group{[a]
[(String, [a])]
groupNamed :: forall a. Group a -> [(String, [a])]
groupHidden :: forall a. Group a -> [a]
groupUnnamed :: forall a. Group a -> [a]
groupNamed :: [(String, [a])]
groupHidden :: [a]
groupUnnamed :: [a]
..} = String -> [(String, Pack)] -> Pack
Ctor String
"Group"
        [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"groupUnnamed" [a]
groupUnnamed
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"groupHidden" [a]
groupHidden
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"groupNamed" [(String, [a])]
groupNamed]
    unpack :: Pack -> Group a
unpack Pack
x = let y :: [(String, Pack)]
y = String -> Pack -> [(String, Pack)]
ctor String
"Group" Pack
x in Group
        {groupUnnamed :: [a]
groupUnnamed = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"groupUnnamed" [(String, Pack)]
y
        ,groupHidden :: [a]
groupHidden = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"groupHidden" [(String, Pack)]
y
        ,groupNamed :: [(String, [a])]
groupNamed = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"groupNamed" [(String, Pack)]
y}

instance Packer a => Packer (Mode a) where
    pack :: Mode a -> Pack
pack Mode{a
Bool
String
[String]
([Arg a], Maybe (Arg a))
Group (Flag a)
Group (Mode a)
a -> Maybe [String]
a -> Either String a
modeGroupFlags :: forall a. Mode a -> Group (Flag a)
modeArgs :: forall a. Mode a -> ([Arg a], Maybe (Arg a))
modeHelpSuffix :: forall a. Mode a -> [String]
modeHelp :: forall a. Mode a -> String
modeExpandAt :: forall a. Mode a -> Bool
modeReform :: forall a. Mode a -> a -> Maybe [String]
modeCheck :: forall a. Mode a -> a -> Either String a
modeValue :: forall a. Mode a -> a
modeNames :: forall a. Mode a -> [String]
modeGroupModes :: forall a. Mode a -> Group (Mode a)
modeGroupFlags :: Group (Flag a)
modeArgs :: ([Arg a], Maybe (Arg a))
modeHelpSuffix :: [String]
modeHelp :: String
modeExpandAt :: Bool
modeReform :: a -> Maybe [String]
modeCheck :: a -> Either String a
modeValue :: a
modeNames :: [String]
modeGroupModes :: Group (Mode a)
..} = String -> [(String, Pack)] -> Pack
Ctor String
"Mode"
        [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeGroupModes" Group (Mode a)
modeGroupModes
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeNames" [String]
modeNames
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeHelp" String
modeHelp
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeHelpSuffix" [String]
modeHelpSuffix
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeArgs" ([Arg a], Maybe (Arg a))
modeArgs
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeGroupFlags" Group (Flag a)
modeGroupFlags
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeValue" a
modeValue
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeCheck" a -> Either String a
modeCheck
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeReform" a -> Maybe [String]
modeReform
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"modeExpandAt" Bool
modeExpandAt]
    unpack :: Pack -> Mode a
unpack Pack
x = let y :: [(String, Pack)]
y = String -> Pack -> [(String, Pack)]
ctor String
"Mode" Pack
x in Mode
        {modeGroupModes :: Group (Mode a)
modeGroupModes = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeGroupModes" [(String, Pack)]
y
        ,modeNames :: [String]
modeNames = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeNames" [(String, Pack)]
y
        ,modeHelp :: String
modeHelp = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeHelp" [(String, Pack)]
y
        ,modeHelpSuffix :: [String]
modeHelpSuffix = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeHelpSuffix" [(String, Pack)]
y
        ,modeArgs :: ([Arg a], Maybe (Arg a))
modeArgs = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeArgs" [(String, Pack)]
y
        ,modeGroupFlags :: Group (Flag a)
modeGroupFlags = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeGroupFlags" [(String, Pack)]
y
        ,modeValue :: a
modeValue = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeValue" [(String, Pack)]
y
        ,modeCheck :: a -> Either String a
modeCheck = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeCheck" [(String, Pack)]
y
        ,modeReform :: a -> Maybe [String]
modeReform = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeReform" [(String, Pack)]
y
        ,modeExpandAt :: Bool
modeExpandAt = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeExpandAt" [(String, Pack)]
y}

instance Packer a => Packer (Flag a) where
    pack :: Flag a -> Pack
pack Flag{String
[String]
FlagInfo
Update a
flagHelp :: forall a. Flag a -> String
flagType :: forall a. Flag a -> String
flagValue :: forall a. Flag a -> Update a
flagInfo :: forall a. Flag a -> FlagInfo
flagNames :: forall a. Flag a -> [String]
flagHelp :: String
flagType :: String
flagValue :: Update a
flagInfo :: FlagInfo
flagNames :: [String]
..} = String -> [(String, Pack)] -> Pack
Ctor String
"Flag"
        [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"flagNames" [String]
flagNames
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"flagInfo" FlagInfo
flagInfo
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"flagType" String
flagType
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"flagHelp" String
flagHelp
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"flagValue" Update a
flagValue]
    unpack :: Pack -> Flag a
unpack Pack
x = let y :: [(String, Pack)]
y = String -> Pack -> [(String, Pack)]
ctor String
"Flag" Pack
x in Flag
        {flagNames :: [String]
flagNames = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"flagNames" [(String, Pack)]
y
        ,flagInfo :: FlagInfo
flagInfo = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"flagInfo" [(String, Pack)]
y
        ,flagType :: String
flagType = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"flagType" [(String, Pack)]
y
        ,flagHelp :: String
flagHelp = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"flagHelp" [(String, Pack)]
y
        ,flagValue :: Update a
flagValue = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"flagValue" [(String, Pack)]
y}

instance Packer a => Packer (Arg a) where
    pack :: Arg a -> Pack
pack Arg{Bool
String
Update a
argRequire :: forall a. Arg a -> Bool
argType :: forall a. Arg a -> String
argValue :: forall a. Arg a -> Update a
argRequire :: Bool
argType :: String
argValue :: Update a
..} = String -> [(String, Pack)] -> Pack
Ctor String
"Arg"
        [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"argType" String
argType
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"argRequire" Bool
argRequire
        ,forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"argValue" Update a
argValue]
    unpack :: Pack -> Arg a
unpack Pack
x = let y :: [(String, Pack)]
y = String -> Pack -> [(String, Pack)]
ctor String
"Arg" Pack
x in Arg
        {argType :: String
argType = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"argType" [(String, Pack)]
y
        ,argRequire :: Bool
argRequire = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"argRequire" [(String, Pack)]
y
        ,argValue :: Update a
argValue = forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"argValue" [(String, Pack)]
y}

instance Packer FlagInfo where
    pack :: FlagInfo -> Pack
pack FlagInfo
FlagReq = String -> [(String, Pack)] -> Pack
Ctor String
"FlagReq" []
    pack (FlagOpt String
x) = String -> [(String, Pack)] -> Pack
Ctor String
"FlagOpt" [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"fromFlagOpt" String
x]
    pack (FlagOptRare String
x) = String -> [(String, Pack)] -> Pack
Ctor String
"FlagOptRare" [forall {a} {a}. Packer a => a -> a -> (a, Pack)
add String
"fromFlagOpt" String
x]
    pack FlagInfo
FlagNone = String -> [(String, Pack)] -> Pack
Ctor String
"FlagNone" []
    unpack :: Pack -> FlagInfo
unpack x :: Pack
x@(Ctor String
name [(String, Pack)]
_) = case String
name of
        String
"FlagReq" -> FlagInfo
FlagReq
        String
"FlagOpt" -> String -> FlagInfo
FlagOpt forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromFlagOpt" forall a b. (a -> b) -> a -> b
$ String -> Pack -> [(String, Pack)]
ctor String
name Pack
x
        String
"FlagOptRare" -> String -> FlagInfo
FlagOptRare forall a b. (a -> b) -> a -> b
$ forall {a} {a}. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromFlagOpt" forall a b. (a -> b) -> a -> b
$ String -> Pack -> [(String, Pack)]
ctor String
name Pack
x
        String
"FlagNone" -> FlagInfo
FlagNone
    unpack Pack
_ = FlagInfo
FlagNone