diff --git a/config.json b/Config/config.json similarity index 100% rename from config.json rename to Config/config.json diff --git a/README.md b/README.md index 21929c1..e21373c 100644 --- a/README.md +++ b/README.md @@ -1 +1,22 @@ # mtgsearch + + +Developement of a custom magic card search engine. + +# DSL + +Will be a language based in set theory, where queries can be combined, negated etc etc. +Example. + +# Lexer + +This languages lexer is very dumb. Therefore you the user has to be very verbose with your parenthesis. Example: + +This will not work: +``` +(IS Instant) union (Color Red) union (Color Green) +``` +However this will +``` +((IS Instant) union (Color Red) union (Color Green)) +``` \ No newline at end of file diff --git a/mtgsearch.cabal b/mtgsearch.cabal index 0ba1e29..c23455e 100644 --- a/mtgsearch.cabal +++ b/mtgsearch.cabal @@ -25,6 +25,8 @@ source-repository head library exposed-modules: + Algorithm.BottomQuery + Algorithm.Lex Algorithm.Search Config Lib diff --git a/src/Algorithm/BottomQuery.hs b/src/Algorithm/BottomQuery.hs new file mode 100644 index 0000000..e69de29 diff --git a/src/Algorithm/Lex.hs b/src/Algorithm/Lex.hs new file mode 100644 index 0000000..d4ba1b8 --- /dev/null +++ b/src/Algorithm/Lex.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} +module Algorithm.Lex + ( lexx + , Token(..)) where +import Prelude hiding (lex) +import Debug.Trace +import Data.ByteString (count, putStr) + +lexx :: String -> Token +lexx qur = do + + let collected = collector qur + let parenthesisFixed = fixSeparators collected + let parenthesis = matchParenthesis parenthesisFixed 0 + seperator parenthesisFixed parenthesis + + +fixSeparators :: [String] -> [String] +fixSeparators ("(":values) = "(":values +fixSeparators values = ["("] ++ values++ [")"] + + +isLegal :: Char -> Bool +isLegal x = x `notElem` ['(',')',' '] + +collector :: String -> [String] +collector [] = [] +collector (x:r) | not $ isLegal x = [x] : collector r +collector elements = case takeWhile isLegal elements of + "" -> collector (dropWhile isLegal elements) + b -> b : collector (dropWhile isLegal elements) + + +matchParenthesis :: [String] -> Int -> [(Int, Int)] +matchParenthesis ("(":rest) count = (count, findClosing rest 0 (count+1)):matchParenthesis rest (count+1) +matchParenthesis (a:rest) count = matchParenthesis rest (count+1) +matchParenthesis [] _ = [] + + +findClosing :: [String] -> Int -> Int -> Int +findClosing (")":xs) stackCount count | stackCount == 0 = count +findClosing (")":xs) stackCount count = findClosing xs (stackCount-1) (count+1) +findClosing ("(":xs) stackCount count = findClosing xs (stackCount+1) (count+1) +findClosing (x:xs) stackCount count = findClosing xs stackCount (count+1) +findClosing [] _ _ = error "Unequal number of parenthesis" + + +data Token = Seperated String Token Token | Queri String deriving Show + +seperator :: [String] -> [(Int, Int)] -> Token +seperator ("(":rest) ((start,end):points) = case drop (end-start) rest of + " ":operator:" ":"(":rightRest -> Seperated operator (seperator (take (end-start) rest) points) (seperator (init rightRest) points) + [] -> seperator (take (end-start) rest) points + _ ->error "Operator need something to the right and left of it!" + + + +seperator [name, " ", value, ")"] points = Queri (name++" "++value) +seperator a _ = Queri "LOL" --error "Something went wrong tokenizing the input!" + + + +--This one works, but not for lines! + +-- seperator :: [String] -> [(Int, Int)] -> Seperated +-- seperator ("(":rest) ((start,end):points) = case drop (end-start) rest of +-- " ":operator:" ":"(":rightRest -> Seperated operator (seperator (take (end-start) rest) points) (seperator (init rightRest) points) +-- [] -> seperator (take (end-start) rest) points +-- a ->trace (show a) error "This is not allowed" + + + + +-- ((Is instant) union (Color R)) union ((Is instant) union (Color R)) +-- (((Color Red) union (Color Blue)) union ((Is instant) union (Is Enchantment))) \ No newline at end of file diff --git a/src/Algorithm/Search.hs b/src/Algorithm/Search.hs index eecb637..75f2650 100644 --- a/src/Algorithm/Search.hs +++ b/src/Algorithm/Search.hs @@ -20,7 +20,8 @@ instance ToRow Card where search :: String -> IO String search q = do - simpleSearch q + let tokens = lexx q + simpleSearch q simpleSearch :: String -> IO String simpleSearch q = do @@ -34,4 +35,4 @@ buildHtml :: [Card] -> String buildHtml = concatMap cardToHtml cardToHtml :: Card -> String -cardToHtml (Card id name image_uri) = "