Finished a dumb lexer

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))
+```

mtgsearch.cabal

@@ -25,6 +25,8 @@ source-repository head
 
 library
   exposed-modules:
+      Algorithm.BottomQuery
+      Algorithm.Lex
       Algorithm.Search
       Config
       Lib

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)))

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) = "<h2>" ++ show name ++ "</h2>" ++ "<img src=" ++ show image_uri ++ "/>"
+cardToHtml (Card id name image_uri) = "<div class=\"card\"><h2>" ++ show name ++ "</h2>" ++ "<img src=" ++ show image_uri ++ "/> </div>"

src/Config.hs

@@ -7,6 +7,11 @@ import Data.Text
 
 import qualified Data.ByteString.Lazy as B
 import GHC.Generics
+import Control.Exception (try)
+import Data.ByteString.Builder (lazyByteString)
+import qualified Data.Aeson.Key as B
+import qualified Data.Data as B
+import GHC.IO.Exception
 
 
 
@@ -18,9 +23,18 @@ data Config = Config{
 instance FromJSON Config
 instance ToJSON Config
 
-configFile = "./config.json"
+
+
+configFile = "./Config/config.json"
+
+
 getJSON :: IO B.ByteString
-getJSON = B.readFile configFile
+getJSON = do
+    a <- try $ B.readFile configFile :: IO (Either IOException B.ByteString )
+    case a of
+        Right a -> return a
+        Left b -> error $ "Could not load configuration file"
+
 
 
 readConfig :: IO (Maybe Config)
@@ -33,6 +47,7 @@ readConfig = do
             putStrLn err
             return Nothing
 
+getConfig :: IO Config
 getConfig = extract readConfig
 
 getDataSeedPath ::IO (String)

src/Site/Host.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
 module Site.Host
     ( host
     ) where
@@ -7,12 +8,18 @@ import Web.Scotty
 import Algorithm.Search
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Data.Text.Lazy (pack)
+import Database.SQLite.Simple (query)
+import Algorithm.Lex (lexx)
 
 host = scotty 3000 $ do
   post "/api/req" $ do
+
             query <-  param "query"
+            liftIO (putStrLn $ "\nOutput!" ++ show (lexx query))
+            cards <- liftIO (search query)
             result <- liftIO (search query)
             html $ mconcat ["<h1>", pack result, "</h1>"]
-  get "/" $ file "src/Site/Static/index.html"
-  
+
+  get "/" $ file "src/Site/Static/index.html"
+