Skip to content

Instantly share code, notes, and snippets.

@btipling
Last active June 25, 2017 23:57
Show Gist options
  • Save btipling/d14861da3d877543165659b490595a0c to your computer and use it in GitHub Desktop.
Save btipling/d14861da3d877543165659b490595a0c to your computer and use it in GitHub Desktop.
Haskell based parenthesis validator
{-|
Module: Validator
Description: Parses parenthesis variations for correct nesting.
Parses (), <>, {}, [] etc for correct nesting, open and closing.
Usage:
$ validator '[<>{()}]'
[<>{()}]
Found valid characters in valid form.
$ validator '[<><><>]'
[<><><>]
Found valid characters in valid form.
$ validator '[(]'
[(]
Valid characters but invalid form.
$ validator '[z]'
[z]
Invalid characters detected, please limit it to ()<>[]{}
-}
module Main where
import System.Environment
import System.Exit
import Data.Map.Strict(assocs, keys, member, Map, fromList, (!?), (!))
data ErrorCodes = NoError | InvalidInput | Invalid deriving (Show, Eq, Enum)
main :: IO ExitCode
main = do
inputChars <- getArgs
let arg = head inputChars
putStrLn arg
if not (validArg arg)
then do
putStrLn ("Invalid characters detected, please limit it to " ++ validChars)
exitWith (ExitFailure (fromEnum InvalidInput))
else if validForm arg
then do
putStrLn "Found valid characters in valid form."
exitSuccess
else do
putStrLn "Valid characters but invalid form."
exitWith (ExitFailure (fromEnum Invalid))
validForm :: String -> Bool
validForm chars
| not ((mod (length chars) 2) == 0) = False -- Not valid as length of input is odd
| otherwise = validFormChecker chars "" -- Begin traversing through characters
validFormChecker :: String -> String -> Bool
-- Recursive validator that adds opening characters to a stack and recurses to validate input.
validFormChecker chars stack
| null stack && null chars = True -- Nothing on the stack and no chars, nothing more to do.
| null chars = False -- If something is on the stack, chars should not be empty.
-- This next line detects if next character is an opening character, adds it to stack and recurses.
| (isOpeningChar (head chars)) && ((validFormChecker (tail chars)) ([(head chars)] ++ stack)) = True
| null stack = False -- This happens when ^^ conditions all have failed and chars is invalid.
| otherwise = (matchingPairs (head chars) (head stack)) && (validFormChecker (tail chars) (tail stack))
isOpeningChar :: Char -> Bool
-- The keys in `getPairs` are all opening characters.
isOpeningChar currentChar = (currentChar `elem` (keys getPairs))
matchingPairs :: Char -> Char -> Bool
-- Detect if current character matches the top of the stack. Basically a value lookup in the getPairs map.
matchingPairs char stackTop = (member stackTop getPairs) && (getPairs ! stackTop == char)
validChars :: String
-- Merges all the key value pairs to create a definitive list of valid characters.
validChars = foldr combineChars [] (assocs getPairs)
combineChars :: (Char, Char) -> [Char] -> [Char]
-- Just concatenating characters to a string.
combineChars (char1, char2) keyPair = [char1] ++ [char2] ++ keyPair
getPairs :: Map Char Char
-- The list of valid character pairs.
getPairs = fromList [ ('[', ']')
, ('{', '}')
, ('(', ')')
, ('<', '>')
]
validArg :: String -> Bool
-- Check all the valid characters by filtering out invalid and comparing the lengths of filtered vs given.
validArg receivedChars = let
vc = validChars
filteredChars = filter (\char -> char `elem` vc) receivedChars
in (length receivedChars) == (length filteredChars)
name: validator
version: 0.1.0.0
license: BSD3
license-file: LICENSE
author: Bjorn Tipling
maintainer: bjorn@ambientchill.com
build-type: Simple
cabal-version: >=1.10
executable validator
main-is: Main.hs
build-depends: base >=4.9 && <4.10,
containers == 0.5.10.2
hs-source-dirs: .
default-language: Haskell2010
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment