{-# LANGUAGE RecordWildCards, TypeSynonymInstances, FlexibleInstances #-}
module System.Console.CmdArgs.Helper(
execute,
Unknown, receive, reply, comment
) where
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
execute
:: String
-> Mode a
-> [String]
-> IO (Either String [String])
execute :: String -> Mode a -> [String] -> IO (Either String [String])
execute String
cmd Mode a
mode [String]
args
| String
"echo" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
cmd = Either String [String] -> IO (Either String [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String [String] -> IO (Either String [String]))
-> Either String [String] -> IO (Either String [String])
forall a b. (a -> b) -> a -> b
$ [String] -> Either String [String]
forall a b. b -> Either a b
Right ([String] -> Either String [String])
-> [String] -> Either String [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
splitArgs (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
cmd
| Bool
otherwise = Handle
-> BufferMode
-> IO (Either String [String])
-> IO (Either String [String])
forall c. Handle -> BufferMode -> IO c -> IO c
withBuffering Handle
stdout BufferMode
NoBuffering (IO (Either String [String]) -> IO (Either String [String]))
-> IO (Either String [String]) -> IO (Either String [String])
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}
Handle -> BufferMode -> IO ()
hSetBuffering Handle
hin BufferMode
LineBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
hout BufferMode
LineBuffering
(String
m, String -> IO String
ans) <- Mode a -> IO (String, String -> IO String)
forall a. Mode a -> IO (String, String -> IO String)
saveMode Mode a
mode
Handle -> String -> IO ()
hOut Handle
hin String
m
(String -> IO String)
-> Handle -> Handle -> IO (Either String [String])
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 " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then
Either String b -> IO (Either String b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String b -> IO (Either String b))
-> Either String b -> IO (Either String b)
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a. Read a => String -> a
read (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
7 String
x
else if String
"Send " String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x then do
Handle -> String -> IO ()
hOut Handle
hin (String -> IO ()) -> IO String -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
ans (Int -> String -> String
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
"#" String -> String -> Bool
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
Either String b -> IO (Either String b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String b -> IO (Either String b))
-> Either String b -> IO (Either String b)
forall a b. (a -> b) -> a -> b
$ String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$ String
"Unexpected message from program: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x
withBuffering :: Handle -> BufferMode -> IO c -> IO c
withBuffering Handle
hndl BufferMode
mode IO c
act = IO BufferMode
-> (BufferMode -> IO ()) -> (BufferMode -> IO c) -> IO c
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; BufferMode -> IO BufferMode
forall (m :: * -> *) a. Monad m => a -> m a
return BufferMode
old)
(Handle -> BufferMode -> IO ()
hSetBuffering Handle
hndl)
(IO c -> BufferMode -> IO c
forall a b. a -> b -> a
const IO c
act)
newtype Unknown = Unknown {Unknown -> Value
fromUnknown :: Value}
receive :: IO (Mode Unknown)
receive :: IO (Mode Unknown)
receive = do
String
m <- IO String
getLine
Mode Unknown -> IO (Mode Unknown)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode Unknown -> IO (Mode Unknown))
-> Mode Unknown -> IO (Mode Unknown)
forall a b. (a -> b) -> a -> b
$ (Value -> Unknown)
-> (Unknown -> Value) -> Mode Value -> Mode Unknown
forall (m :: * -> *) a b.
Remap m =>
(a -> b) -> (b -> a) -> m a -> m b
remap2 Value -> Unknown
Unknown Unknown -> Value
fromUnknown (Mode Value -> Mode Unknown) -> Mode Value -> Mode Unknown
forall a b. (a -> b) -> a -> b
$ String -> (String -> String) -> Mode Value
loadMode String
m ((String -> String) -> Mode Value)
-> (String -> String) -> Mode Value
forall a b. (a -> b) -> a -> b
$ \String
msg -> IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ do
Handle -> String -> IO ()
hOut Handle
stdout (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Send " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
IO String
getLine
reply :: Either String [String] -> IO ()
reply :: Either String [String] -> IO ()
reply Either String [String]
x = do
Handle -> String -> IO ()
hOut Handle
stdout (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Result " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Either String [String] -> String
forall a. Show a => a -> String
show Either String [String]
x
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
ExitSuccess
comment :: String -> IO ()
String
x = Handle -> String -> IO ()
hOut Handle
stdout (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"# " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
data IOMap a = IOMap (IORef (Int,[(Int,a)]))
newIOMap :: IO (IOMap a)
newIOMap :: IO (IOMap a)
newIOMap = (IORef (Int, [(Int, a)]) -> IOMap a)
-> IO (IORef (Int, [(Int, a)])) -> IO (IOMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IORef (Int, [(Int, a)]) -> IOMap a
forall a. IORef (Int, [(Int, a)]) -> IOMap a
IOMap (IO (IORef (Int, [(Int, a)])) -> IO (IOMap a))
-> IO (IORef (Int, [(Int, a)])) -> IO (IOMap a)
forall a b. (a -> b) -> a -> b
$ (Int, [(Int, a)]) -> IO (IORef (Int, [(Int, a)]))
forall a. a -> IO (IORef a)
newIORef (Int
0, [])
addIOMap :: IOMap a -> a -> IO Int
addIOMap :: IOMap a -> a -> IO Int
addIOMap (IOMap IORef (Int, [(Int, a)])
ref) a
x = IORef (Int, [(Int, a)])
-> ((Int, [(Int, a)]) -> ((Int, [(Int, a)]), Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (Int, [(Int, a)])
ref (((Int, [(Int, a)]) -> ((Int, [(Int, a)]), Int)) -> IO Int)
-> ((Int, [(Int, a)]) -> ((Int, [(Int, a)]), Int)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(Int
i,[(Int, a)]
xs) -> let j :: Int
j = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in ((Int
j,(Int
j,a
x)(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:[(Int, a)]
xs), Int
j)
getIOMap :: IOMap a -> Int -> IO a
getIOMap :: IOMap a -> Int -> IO a
getIOMap (IOMap IORef (Int, [(Int, a)])
ref) Int
i = do (Int
_,[(Int, a)]
xs) <- IORef (Int, [(Int, a)]) -> IO (Int, [(Int, a)])
forall a. IORef a -> IO a
readIORef IORef (Int, [(Int, a)])
ref; a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i [(Int, a)]
xs
newtype Value = Value Int
{-# NOINLINE toValue #-}
toValue :: Mode a -> Mode Value
toValue :: Mode a -> Mode Value
toValue Mode a
x = IO (Mode Value) -> Mode Value
forall a. IO a -> a
unsafePerformIO (IO (Mode Value) -> Mode Value) -> IO (Mode Value) -> Mode Value
forall a b. (a -> b) -> a -> b
$ do
IOMap a
mp <- IO (IOMap a)
forall a. IO (IOMap a)
newIOMap
let embed :: a -> Value
embed a
x = IO Value -> Value
forall a. IO a -> a
unsafePerformIO (IO Value -> Value) -> IO Value -> Value
forall a b. (a -> b) -> a -> b
$ (Int -> Value) -> IO Int -> IO Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Value
Value (IO Int -> IO Value) -> IO Int -> IO Value
forall a b. (a -> b) -> a -> b
$ IOMap a -> a -> IO Int
forall a. IOMap a -> a -> IO Int
addIOMap IOMap a
mp a
x
proj :: Value -> a
proj (Value Int
x) = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ IOMap a -> Int -> IO a
forall a. IOMap a -> Int -> IO a
getIOMap IOMap a
mp Int
x
Mode Value -> IO (Mode Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Mode Value -> IO (Mode Value)) -> Mode Value -> IO (Mode Value)
forall a b. (a -> b) -> a -> b
$ (a -> Value) -> (Value -> a) -> Mode a -> Mode Value
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)
saveMode :: Mode a -> IO (String, String -> IO String)
saveMode Mode a
m = do
IOMap (Pack -> Pack)
mp <- IO (IOMap (Pack -> Pack))
forall a. IO (IOMap a)
newIOMap
Pack
res <- IOMap (Pack -> Pack) -> Pack -> IO Pack
add IOMap (Pack -> Pack)
mp (Pack -> IO Pack) -> Pack -> IO Pack
forall a b. (a -> b) -> a -> b
$ Mode Value -> Pack
forall a. Packer a => a -> Pack
pack (Mode Value -> Pack) -> Mode Value -> Pack
forall a b. (a -> b) -> a -> b
$ Mode a -> Mode Value
forall a. Mode a -> Mode Value
toValue Mode a
m
(String, String -> IO String) -> IO (String, String -> IO String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String -> IO String) -> IO (String, String -> IO String))
-> (String, String -> IO String)
-> IO (String, String -> IO String)
forall a b. (a -> b) -> a -> b
$ (Pack -> String
forall a. Show a => a -> String
show Pack
res, (Pack -> String) -> IO Pack -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pack -> String
forall a. Show a => a -> String
show (IO Pack -> IO String)
-> (String -> IO Pack) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOMap (Pack -> Pack) -> (Int, Pack) -> IO Pack
get IOMap (Pack -> Pack)
mp ((Int, Pack) -> IO Pack)
-> (String -> (Int, Pack)) -> String -> IO Pack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Int, Pack)
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 = ((Pack -> IO Pack) -> Pack -> IO Pack)
-> Pack -> (Pack -> IO Pack) -> IO Pack
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Pack -> IO Pack) -> Pack -> IO Pack
forall (m :: * -> *). Monad m => (Pack -> m Pack) -> Pack -> m Pack
transformM Pack
x ((Pack -> IO Pack) -> IO Pack) -> (Pack -> IO Pack) -> IO Pack
forall a b. (a -> b) -> a -> b
$ \Pack
x -> case Pack
x of
Func (NoShow Pack -> Pack
f) -> do Int
i <- IOMap (Pack -> Pack) -> (Pack -> Pack) -> IO Int
forall a. IOMap a -> a -> IO Int
addIOMap IOMap (Pack -> Pack)
mp Pack -> Pack
f; Pack -> IO Pack
forall (m :: * -> *) a. Monad m => a -> m a
return (Pack -> IO Pack) -> Pack -> IO Pack
forall a b. (a -> b) -> a -> b
$ Int -> Pack
FuncId Int
i
Pack
x -> Pack -> IO Pack
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 <- IOMap (Pack -> Pack) -> Int -> IO (Pack -> Pack)
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 (Pack -> IO Pack) -> Pack -> IO Pack
forall a b. (a -> b) -> a -> b
$ Pack -> Pack
f Pack
x
loadMode :: String -> (String -> String) -> Mode Value
loadMode :: String -> (String -> String) -> Mode Value
loadMode String
x String -> String
f = Pack -> Mode Value
forall a. Packer a => Pack -> a
unpack (Pack -> Mode Value) -> Pack -> Mode Value
forall a b. (a -> b) -> a -> b
$ Pack -> Pack
rep (Pack -> Pack) -> Pack -> Pack
forall a b. (a -> b) -> a -> b
$ String -> Pack
forall a. Read a => String -> a
read String
x
where
rep :: Pack -> Pack
rep :: Pack -> Pack
rep Pack
x = ((Pack -> Pack) -> Pack -> Pack) -> Pack -> (Pack -> Pack) -> Pack
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Pack -> Pack) -> Pack -> Pack
transform Pack
x ((Pack -> Pack) -> Pack) -> (Pack -> Pack) -> Pack
forall a b. (a -> b) -> a -> b
$ \Pack
x -> case Pack
x of
FuncId Int
i -> NoShow (Pack -> Pack) -> Pack
Func (NoShow (Pack -> Pack) -> Pack) -> NoShow (Pack -> Pack) -> Pack
forall a b. (a -> b) -> a -> b
$ (Pack -> Pack) -> NoShow (Pack -> Pack)
forall a. a -> NoShow a
NoShow ((Pack -> Pack) -> NoShow (Pack -> Pack))
-> (Pack -> Pack) -> NoShow (Pack -> Pack)
forall a b. (a -> b) -> a -> b
$ \Pack
y -> Pack -> Pack
rep (Pack -> Pack) -> Pack -> Pack
forall a b. (a -> b) -> a -> b
$ String -> Pack
forall a. Read a => String -> a
read (String -> Pack) -> String -> Pack
forall a b. (a -> b) -> a -> b
$ String -> String
f (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Int, Pack) -> String
forall a. Show a => a -> String
show (Int
i,Pack
y)
Pack
x -> Pack
x
data Pack = Ctor String [(String, Pack)]
| List [Pack]
| Char Char
| Int Int
| Func (NoShow (Pack -> Pack))
| FuncId Int
| String String
| None
deriving (Int -> Pack -> String -> String
[Pack] -> String -> String
Pack -> String
(Int -> Pack -> String -> String)
-> (Pack -> String) -> ([Pack] -> String -> String) -> Show Pack
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]
(Int -> ReadS Pack)
-> ReadS [Pack] -> ReadPrec Pack -> ReadPrec [Pack] -> Read 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 = String -> Int -> NoShow a -> String -> String
forall a. HasCallStack => String -> a
error String
"Cannot show value of type NoShow"
instance Read (NoShow a) where readsPrec :: Int -> ReadS (NoShow a)
readsPrec = String -> Int -> ReadS (NoShow a)
forall a. HasCallStack => String -> a
error String
"Cannot read value of type NoShow"
transformM, descendM :: Monad m => (Pack -> m Pack) -> Pack -> m Pack
transformM :: (Pack -> m Pack) -> Pack -> m Pack
transformM Pack -> m Pack
f Pack
x = Pack -> m Pack
f (Pack -> m Pack) -> m Pack -> m Pack
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Pack -> m Pack) -> Pack -> m Pack
forall (m :: * -> *). Monad m => (Pack -> m Pack) -> Pack -> m Pack
descendM ((Pack -> m Pack) -> Pack -> m Pack
forall (m :: * -> *). Monad m => (Pack -> m Pack) -> Pack -> m Pack
transformM Pack -> m Pack
f) Pack
x
descendM :: (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 ([Pack] -> Pack) -> m [Pack] -> m Pack
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Pack] -> Pack
b (m [Pack] -> m Pack) -> m [Pack] -> m Pack
forall a b. (a -> b) -> a -> b
$ (Pack -> m Pack) -> [Pack] -> m [Pack]
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 (Pack -> Pack) -> (Pack -> Pack) -> Pack -> Pack
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 ([Pack] -> Pack) -> [Pack] -> Pack
forall a b. (a -> b) -> a -> b
$ (Pack -> Pack) -> [Pack] -> [Pack]
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) = (((String, Pack) -> Pack) -> [(String, Pack)] -> [Pack]
forall a b. (a -> b) -> [a] -> [b]
map (String, Pack) -> Pack
forall a b. (a, b) -> b
snd [(String, Pack)]
ys, String -> [(String, Pack)] -> Pack
Ctor String
x ([(String, Pack)] -> Pack)
-> ([Pack] -> [(String, Pack)]) -> [Pack] -> Pack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Pack] -> [(String, Pack)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((String, Pack) -> String) -> [(String, Pack)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Pack) -> String
forall a b. (a, b) -> a
fst [(String, Pack)]
ys))
uniplate Pack
x = ([], Pack -> [Pack] -> Pack
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, a -> Pack
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 String -> String -> Bool
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 = Pack -> a
forall a. Packer a => Pack -> a
unpack (Pack -> a) -> Pack -> a
forall a b. (a -> b) -> a -> b
$ Pack -> Maybe Pack -> Pack
forall a. a -> Maybe a -> a
fromMaybe Pack
None (Maybe Pack -> Pack) -> Maybe Pack -> Pack
forall a b. (a -> b) -> a -> b
$ a -> [(a, Pack)] -> Maybe Pack
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
a [(a, Pack)]
b
instance Packer a => Packer [a] where
pack :: [a] -> Pack
pack [a]
xs = if [Pack] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pack]
ys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
zs Bool -> Bool -> Bool
&& Bool -> Bool
not ([Pack] -> Bool
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 = (a -> Pack) -> [a] -> [Pack]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Pack
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) = Pack -> [a]
forall a. Packer a => Pack -> a
unpack (Pack -> [a]) -> Pack -> [a]
forall a b. (a -> b) -> a -> b
$ [Pack] -> Pack
List ([Pack] -> Pack) -> [Pack] -> Pack
forall a b. (a -> b) -> a -> b
$ (Char -> Pack) -> String -> [Pack]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Pack
Char String
xs
unpack (List [Pack]
xs) = (Pack -> a) -> [Pack] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Pack -> a
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 (NoShow (Pack -> Pack) -> Pack) -> NoShow (Pack -> Pack) -> Pack
forall a b. (a -> b) -> a -> b
$ (Pack -> Pack) -> NoShow (Pack -> Pack)
forall a. a -> NoShow a
NoShow ((Pack -> Pack) -> NoShow (Pack -> Pack))
-> (Pack -> Pack) -> NoShow (Pack -> Pack)
forall a b. (a -> b) -> a -> b
$ b -> Pack
forall a. Packer a => a -> Pack
pack (b -> Pack) -> (Pack -> b) -> Pack -> Pack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Pack -> a) -> Pack -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pack -> a
forall a. Packer a => Pack -> a
unpack
unpack :: Pack -> a -> b
unpack (Func (NoShow Pack -> Pack
f)) = Pack -> b
forall a. Packer a => Pack -> a
unpack (Pack -> b) -> (a -> Pack) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pack -> Pack
f (Pack -> Pack) -> (a -> Pack) -> a -> Pack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Pack
forall a. Packer a => a -> Pack
pack
instance Packer Value where
pack :: Value -> Pack
pack (Value Int
x) = Int -> Pack
forall a. Packer a => a -> Pack
pack Int
x
unpack :: Pack -> Value
unpack Pack
x = Int -> Value
Value (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ Pack -> Int
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
"(,)" [String -> a -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"fst" a
a, String -> b -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"snd" b
b]
unpack :: Pack -> (a, b)
unpack Pack
x = (String -> [(String, Pack)] -> a
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fst" [(String, Pack)]
y, String -> [(String, Pack)] -> b
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" [String -> a -> (String, Pack)
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)]
_) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ String -> [(String, Pack)] -> a
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromJust" ([(String, Pack)] -> a) -> [(String, Pack)] -> a
forall a b. (a -> b) -> a -> b
$ String -> Pack -> [(String, Pack)]
ctor String
"Just" Pack
x
unpack Pack
_ = Maybe a
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" [String -> a -> (String, Pack)
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" [String -> b -> (String, Pack)
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)]
_) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ String -> [(String, Pack)] -> a
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromLeft" ([(String, Pack)] -> a) -> [(String, Pack)] -> a
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)]
_) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> b -> Either a b
forall a b. (a -> b) -> a -> b
$ String -> [(String, Pack)] -> b
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromRight" ([(String, Pack)] -> b) -> [(String, Pack)] -> b
forall a b. (a -> b) -> a -> b
$ String -> Pack -> [(String, Pack)]
ctor String
"Right" Pack
x
unpack Pack
_ = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ Pack -> a
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
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"
[String -> [a] -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"groupUnnamed" [a]
groupUnnamed
,String -> [a] -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"groupHidden" [a]
groupHidden
,String -> [(String, [a])] -> (String, Pack)
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 :: forall a. [a] -> [a] -> [(String, [a])] -> Group a
Group
{groupUnnamed :: [a]
groupUnnamed = String -> [(String, Pack)] -> [a]
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"groupUnnamed" [(String, Pack)]
y
,groupHidden :: [a]
groupHidden = String -> [(String, Pack)] -> [a]
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"groupHidden" [(String, Pack)]
y
,groupNamed :: [(String, [a])]
groupNamed = String -> [(String, Pack)] -> [(String, [a])]
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"
[String -> Group (Mode a) -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"modeGroupModes" Group (Mode a)
modeGroupModes
,String -> [String] -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"modeNames" [String]
modeNames
,String -> String -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"modeHelp" String
modeHelp
,String -> [String] -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"modeHelpSuffix" [String]
modeHelpSuffix
,String -> ([Arg a], Maybe (Arg a)) -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"modeArgs" ([Arg a], Maybe (Arg a))
modeArgs
,String -> Group (Flag a) -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"modeGroupFlags" Group (Flag a)
modeGroupFlags
,String -> a -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"modeValue" a
modeValue
,String -> (a -> Either String a) -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"modeCheck" a -> Either String a
modeCheck
,String -> (a -> Maybe [String]) -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"modeReform" a -> Maybe [String]
modeReform
,String -> Bool -> (String, Pack)
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 :: forall a.
Group (Mode a)
-> [String]
-> a
-> (a -> Either String a)
-> (a -> Maybe [String])
-> Bool
-> String
-> [String]
-> ([Arg a], Maybe (Arg a))
-> Group (Flag a)
-> Mode a
Mode
{modeGroupModes :: Group (Mode a)
modeGroupModes = String -> [(String, Pack)] -> Group (Mode a)
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeGroupModes" [(String, Pack)]
y
,modeNames :: [String]
modeNames = String -> [(String, Pack)] -> [String]
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeNames" [(String, Pack)]
y
,modeHelp :: String
modeHelp = String -> [(String, Pack)] -> String
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeHelp" [(String, Pack)]
y
,modeHelpSuffix :: [String]
modeHelpSuffix = String -> [(String, Pack)] -> [String]
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeHelpSuffix" [(String, Pack)]
y
,modeArgs :: ([Arg a], Maybe (Arg a))
modeArgs = String -> [(String, Pack)] -> ([Arg a], Maybe (Arg a))
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeArgs" [(String, Pack)]
y
,modeGroupFlags :: Group (Flag a)
modeGroupFlags = String -> [(String, Pack)] -> Group (Flag a)
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeGroupFlags" [(String, Pack)]
y
,modeValue :: a
modeValue = String -> [(String, Pack)] -> a
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeValue" [(String, Pack)]
y
,modeCheck :: a -> Either String a
modeCheck = String -> [(String, Pack)] -> a -> Either String a
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeCheck" [(String, Pack)]
y
,modeReform :: a -> Maybe [String]
modeReform = String -> [(String, Pack)] -> a -> Maybe [String]
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"modeReform" [(String, Pack)]
y
,modeExpandAt :: Bool
modeExpandAt = String -> [(String, Pack)] -> Bool
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"
[String -> [String] -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"flagNames" [String]
flagNames
,String -> FlagInfo -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"flagInfo" FlagInfo
flagInfo
,String -> String -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"flagType" String
flagType
,String -> String -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"flagHelp" String
flagHelp
,String -> Update a -> (String, Pack)
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 :: forall a.
[String] -> FlagInfo -> Update a -> String -> String -> Flag a
Flag
{flagNames :: [String]
flagNames = String -> [(String, Pack)] -> [String]
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"flagNames" [(String, Pack)]
y
,flagInfo :: FlagInfo
flagInfo = String -> [(String, Pack)] -> FlagInfo
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"flagInfo" [(String, Pack)]
y
,flagType :: String
flagType = String -> [(String, Pack)] -> String
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"flagType" [(String, Pack)]
y
,flagHelp :: String
flagHelp = String -> [(String, Pack)] -> String
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"flagHelp" [(String, Pack)]
y
,flagValue :: Update a
flagValue = String -> [(String, Pack)] -> Update a
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"
[String -> String -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"argType" String
argType
,String -> Bool -> (String, Pack)
forall a a. Packer a => a -> a -> (a, Pack)
add String
"argRequire" Bool
argRequire
,String -> Update a -> (String, Pack)
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 :: forall a. Update a -> String -> Bool -> Arg a
Arg
{argType :: String
argType = String -> [(String, Pack)] -> String
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"argType" [(String, Pack)]
y
,argRequire :: Bool
argRequire = String -> [(String, Pack)] -> Bool
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"argRequire" [(String, Pack)]
y
,argValue :: Update a
argValue = String -> [(String, Pack)] -> Update a
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" [String -> String -> (String, Pack)
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" [String -> String -> (String, Pack)
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 (String -> FlagInfo) -> String -> FlagInfo
forall a b. (a -> b) -> a -> b
$ String -> [(String, Pack)] -> String
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromFlagOpt" ([(String, Pack)] -> String) -> [(String, Pack)] -> String
forall a b. (a -> b) -> a -> b
$ String -> Pack -> [(String, Pack)]
ctor String
name Pack
x
String
"FlagOptRare" -> String -> FlagInfo
FlagOptRare (String -> FlagInfo) -> String -> FlagInfo
forall a b. (a -> b) -> a -> b
$ String -> [(String, Pack)] -> String
forall a a. (Packer a, Eq a) => a -> [(a, Pack)] -> a
get String
"fromFlagOpt" ([(String, Pack)] -> String) -> [(String, Pack)] -> String
forall a b. (a -> b) -> a -> b
$ String -> Pack -> [(String, Pack)]
ctor String
name Pack
x
String
"FlagNone" -> FlagInfo
FlagNone
unpack Pack
_ = FlagInfo
FlagNone