{-# LANGUAGE RecordWildCards #-}
module System.Console.CmdArgs.Explicit.SplitJoin(splitArgs, joinArgs) where
import Data.Char
import Data.Maybe
joinArgs :: [String] -> String
joinArgs :: [String] -> String
joinArgs = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f
where
f :: String -> String
f x :: String
x = String
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
g String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
q
where
hasSpace :: Bool
hasSpace = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
x
q :: String
q = ['\"' | Bool
hasSpace Bool -> Bool -> Bool
|| String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
x]
g :: String -> String
g ('\\':'\"':xs :: String
xs) = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\"'Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
g String
xs
g "\\" | Bool
hasSpace = "\\\\"
g ('\"':xs :: String
xs) = '\\'Char -> String -> String
forall a. a -> [a] -> [a]
:'\"'Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
g String
xs
g (x :: Char
x:xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
g String
xs
g [] = []
data State = Init
| Norm
| Quot
splitArgs :: String -> [String]
splitArgs :: String -> [String]
splitArgs = [Maybe Char] -> [String]
join ([Maybe Char] -> [String])
-> (String -> [Maybe Char]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> String -> [Maybe Char]
f State
Init
where
join :: [Maybe Char] -> [String]
join :: [Maybe Char] -> [String]
join [] = []
join xs :: [Maybe Char]
xs = (Maybe Char -> Char) -> [Maybe Char] -> String
forall a b. (a -> b) -> [a] -> [b]
map Maybe Char -> Char
forall a. HasCallStack => Maybe a -> a
fromJust [Maybe Char]
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [Maybe Char] -> [String]
join (Int -> [Maybe Char] -> [Maybe Char]
forall a. Int -> [a] -> [a]
drop 1 [Maybe Char]
b)
where (a :: [Maybe Char]
a,b :: [Maybe Char]
b) = (Maybe Char -> Bool)
-> [Maybe Char] -> ([Maybe Char], [Maybe Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Maybe Char -> Bool
forall a. Maybe a -> Bool
isNothing [Maybe Char]
xs
f :: State -> String -> [Maybe Char]
f Init (x :: Char
x:xs :: String
xs) | Char -> Bool
isSpace Char
x = State -> String -> [Maybe Char]
f State
Init String
xs
f Init "\"\"" = [Maybe Char
forall a. Maybe a
Nothing]
f Init "\"" = [Maybe Char
forall a. Maybe a
Nothing]
f Init xs :: String
xs = State -> String -> [Maybe Char]
f State
Norm String
xs
f m :: State
m ('\"':'\"':'\"':xs :: String
xs) = Char -> Maybe Char
forall a. a -> Maybe a
Just '\"' Maybe Char -> [Maybe Char] -> [Maybe Char]
forall a. a -> [a] -> [a]
: State -> String -> [Maybe Char]
f State
m String
xs
f m :: State
m ('\\':'\"':xs :: String
xs) = Char -> Maybe Char
forall a. a -> Maybe a
Just '\"' Maybe Char -> [Maybe Char] -> [Maybe Char]
forall a. a -> [a] -> [a]
: State -> String -> [Maybe Char]
f State
m String
xs
f m :: State
m ('\\':'\\':'\"':xs :: String
xs) = Char -> Maybe Char
forall a. a -> Maybe a
Just '\\' Maybe Char -> [Maybe Char] -> [Maybe Char]
forall a. a -> [a] -> [a]
: State -> String -> [Maybe Char]
f State
m ('\"'Char -> String -> String
forall a. a -> [a] -> [a]
:String
xs)
f Norm ('\"':xs :: String
xs) = State -> String -> [Maybe Char]
f State
Quot String
xs
f Quot ('\"':'\"':xs :: String
xs) = Char -> Maybe Char
forall a. a -> Maybe a
Just '\"' Maybe Char -> [Maybe Char] -> [Maybe Char]
forall a. a -> [a] -> [a]
: State -> String -> [Maybe Char]
f State
Norm String
xs
f Quot ('\"':xs :: String
xs) = State -> String -> [Maybe Char]
f State
Norm String
xs
f Norm (x :: Char
x:xs :: String
xs) | Char -> Bool
isSpace Char
x = Maybe Char
forall a. Maybe a
Nothing Maybe Char -> [Maybe Char] -> [Maybe Char]
forall a. a -> [a] -> [a]
: State -> String -> [Maybe Char]
f State
Init String
xs
f m :: State
m (x :: Char
x:xs :: String
xs) = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x Maybe Char -> [Maybe Char] -> [Maybe Char]
forall a. a -> [a] -> [a]
: State -> String -> [Maybe Char]
f State
m String
xs
f m :: State
m [] = []