Quill2.hs

{- |
   Module      :   Cookbook.Project.Quill.Quill2
   Copyright   :   (c) 2014 by Nate Pisarski
   License     :   BSD3
   Maintainer  :   nathanpisarski@gmail.com
   Stability   :   Stable
   Portability :   Portable (Cookbook
Another library for managing databases. It GREATLY breaks compatibility with Quill, and it will eventually deprecate Quill. It's a whitespace-independant string-based flat file language for database information. Some advantages that Quill2 has over Quill include: Record database entries, list support, better commenting support, more complete API, and greater error handling / safety.
-}

module Cookbook.Project.Quill.Quill2 where

import qualified Cookbook.Essential.Common         as Cm
import qualified Cookbook.Essential.Continuous     as Ct

import qualified Cookbook.Ingredients.Lists.Modify    as Md
import qualified Cookbook.Ingredients.Lists.Access    as Ac
import qualified Cookbook.Ingredients.Lists.Encompass as En
import qualified Cookbook.Ingredients.Tupples.Look    as Lk

-- Data types and Instances
-- | The body of a table or list.
data Element a = List [a] | Table [(a,a)] deriving (Eq, Show)

-- | Helper type. Binds a name to a body.
type Quill = (String,Element String)
  
-- Preprocessing functions - Turning raw text into a more easily workable format.

-- | Strip comments from a sanitized string. Comments start with /* and end with */.
decomment :: String -> String
decomment = (`Ct.splice` ("/*", "*/"))

-- | Prepare the lines of a file for processing.
prepare :: [String] -> String
prepare = decomment . (`Ct.remove` '\n') . unlines

-- Text processing - Turning the preprocessed text into data.

-- | Process a single entry in the database into a Table.
pTable :: String -> Quill
pTable x = typ
  where
    name = Md.between (Ct.before x '{') ('(',')') --table(name) or list(name)
    typ  = (name,if (Ct.before x '{') `Ac.contains` "table" then Table (parseTables body) else List body)
    body = Md.splitOn (En.encompassing x ('{','}')) ';'
    quoted y = if ('`','\'') `Ac.surrounds` y then En.encompassing x ('`','\'') else Ct.remove y ' '
    parseTables [] = []
    parseTables (x:xs) =(quoted $ Ct.before x ':', Ct.after x ':') : parseTables xs

-- | Turn the lines of a file into a list of tables, AKA a Database.
pFile :: [String] -> [Quill]
pFile x = case allTables of
  [] -> []
  (y:ys) -> pTable y : pFile ys
  where
    prepared  = prepare x
    allTables = Md.splitOn prepared '}'

-- API functions for creating and reading tables.

data QuillStatus = QuillSuccess Quill | QuillMissing | QuillMultiple deriving (Eq,Show)

getQuillName :: Quill -> String
getQuillName = fst

getQuill :: [Quill] -> String -> QuillStatus
getQuill [] _ = QuillMissing
getQuill (x:xs) c
  | Ac.count (map getQuillName (x:xs)) c > 1 = QuillMultiple
  | getQuillName x  == c = QuillSuccess x
  | otherwise = getQuill xs c

lookUp :: [Quill] -> (String, String) -> String
lookUp x (a,b) = case (getQuill x a) of
  QuillMissing  -> error $ "Table not found."
  QuillMultiple -> error $ "Multiple values of " ++ a ++ " detected. Database eror, fix manually."
  (QuillSuccess (c,d)) -> case d of
    (List f) -> error "Cannot look up the value of a list."
    (Table f) -> let c = Lk.lookList f b in if (c == []) then (error $ "Item " ++ b ++ " not found in table " ++ a) else (if (length c > 1) then multipleInnerError else (head c))
    where multipleInnerError = error $ "Multiple values of " ++ b ++ " found in table " ++ a ++ ". Database corrupted, change manually."

removeQuill :: [Quill] -> String -> [Quill]
removeQuill [] _ = []
removeQuill ((x,y):xs) c
  | x == c = removeQuill xs c -- See [Q2N1]
  | otherwise = (x,y) : removeQuill xs c

removeItem :: [Quill] -> (String, String) -> [Quill]
removeItem x (a,b) = case (getQuill x a) of
  QuillSuccess (c,j) -> case j of
    (Table d) -> (c,(Table [(y,t) | (y,t) <- d, y /= b])) : (removeQuill x a)
    (List d) -> (c,List $ Ct.remove d c) : removeQuill x a
  _ -> (let l = lookUp x (a,b) in x) -- This goes against everything that haskell means.

addQuill :: [Quill] -> Quill -> [Quill]
addQuill x c = c : x

addToQuill :: Quill -> (String, String) -> Quill
addToQuill (x,b) c = case b of
  (Table z) -> (x, Table (c:z))
  (List z) ->  (x, List (z))

addItem :: [Quill] -> (String, String, String) -> [Quill]
addItem x (a, b, c)= case getQuill x a of
  QuillSuccess (y, ys) -> case ys of
    (Table d) -> (y,Table $ (b,c) : d) : removeQuill x a
    (List d)  -> (y,List  $ (c:d)) : removeQuill x a
  QuillMultiple -> error "Multiple found"
  QuillMissing -> error "Not found quill!"

changeItem :: [Quill] -> (String, String, String) -> [Quill]
changeItem x (a,b,c) = addItem (removeItem x (a,b)) (a,b,c)

-- Helping functions for writing / reading to files.
-- | Turn a Quill table into a string.
toString :: Quill -> String
toString (nm,typ) = case typ of
  (List a)  -> ("list(" ++ nm ++ "){" ++ (Cm.flt (map (\c -> (c ++ ";")) a))) ++ "}"
  (Table a) -> ("table(" ++ nm ++ "){" ++ (Cm.flt $ stringify a)) ++ "}"
  where
    stringify [] = []
    stringify ((a,b):xs) = (a ++ ":" ++ b ++ ";") : stringify xs

-- [Q2N1]
-- I had a long debate about this function. What it does is removes tables, but it will remove ALL tables. Since
-- Quill2 treats multiple tables of the same name as an error, I'm choosing to make it a sanitization function as
-- well. Database clients beware.