Hashell-0.15: Hashell/Parse.hs

{-
  Parsing functions.
  Copyright (C) 2005, 2008 Luis Francisco Araujo
-}

module Parse
    where

import Text.ParserCombinators.Parsec
import qualified Text.ParserCombinators.Parsec.Prim as P (try)

----------------------------------------------------------------------------------
-- | Get command name.
getCmd :: String -> String
getCmd = concat . take 1 . words

-- | Get command line arguments.
getArg :: String -> [String]
getArg s = if all (== ' ') s then [] else tail $ hParse s

----------------------------------------------------------------------------------
-- | Main entry for parsing expressions (quote , special characters etc).
-- It takes the expression and returns it tokenized.
hParse :: String -> [String]
hParse = map (`esc` '\\')
         . filter (not . null)
         . concat
         . quotes

----------------------------------------------------------------------------------
-- | Use this function to restore a whitespace
-- in some expressions needed. (Those parsed with
-- splitRegex mainly).
restoreWhiteSpace :: (String -> String)
restoreWhiteSpace = (++ " ")

----------------------------------------------------------------------------------
-- | Split into a specific element.
splitInto :: (Ord a) => a -> [a] -> [[a]]
splitInto _ [] = []
splitInto c e = let (l , e') = break (== c) e
                    in
                    l : case e' of
                                [] -> []
                                (_:e'') -> splitInto c e''

----------------------------------------------------------------------------------
-- | Returns a boolean value if it finds
-- all the elements of a list.
findSubStr :: (Eq a) => [a] -> [a] -> Bool
findSubStr [] [] = False
findSubStr as bs = let f [] _ = True
                       f _ [] = False
                       f (a:as') (b:bs')
                           | a == b = f as' bs'
                           | a /= b = f as bs'
                       f _ _ = False
                       in
                       f as bs

----------------------------------------------------------------------------------
-- | Concatenate a list with a specifc delimiter.
joinWith :: [String] -> String -> String
joinWith xs y = foldr (\ a b -> a ++ (if null b then [] else y ++ b)) [] xs

----------------------------------------------------------------------------------
-- | Escape the special character 'c' in the expression.
esc :: String -> Char -> String
esc [] _ =  []
esc (x:y:xs) c
    | c == x = y : esc xs c
esc (x:xs) c = if x == c then [] else x : esc xs c

-- | Parse command haskell expressions.
type Terna = (String, String, String)

gParser :: Parser Terna -> String -> Terna
gParser p = f
    where
    f e = case (parse p "" e) of
              Left _ -> ("", "", (show e))
              Right t -> t

parseCH :: String -> Terna
parseCH = gParser comHaskell

comHaskell :: Parser Terna
comHaskell = do{ b <- manyTill anyChar (P.try (string "(-"))
               ; p <- manyTill anyChar (P.try (string "-)"))
               ; a <- many anyChar
               ; return (b, p, a)
               }

-- | Parse quotes.
parseQuote :: String -> Terna
parseQuote = gParser quote

quotes :: String -> [[String]]
quotes [] = []
quotes e | null b && null q && null a = []
         | otherwise = ((words b) : [q] : quotes a)
         where
         (b, q, a) = parseQuote e

escapeseq :: Parser String
escapeseq = (P.try $ string "''") <|>
            (P.try $ string "\\'")

quote :: Parser Terna
quote = do{ b <- many (noneOf ['\''])
          ; many (char '\'')
          ; s <- many $ (escapeseq <|> (noneOf "'"
                                        >>= (\x -> return [x])))
          ; many (char '\'')
          ; a <- many anyChar
          ; return (b, (concat s), a)
          }