Tables-0.1.0.2: Main.hs

{- |
   Module      :   Tables.Tables2
   Copyright   :   (c) 2014 by Nate Pisarski
   License     :   BSD3
   Maintainer  :   nathanpisarski@gmail.com
   Stability   :   Stable
   Portability :   Portable (Standalone - ghc)
   Database client for the Quill2 database language. Use this, as Tables1 will be deprecated on June 1st, 2014.
-}
module Main(main,dispatch) where

import qualified Cookbook.Project.Quill.Quill2.Meta as Qm
import qualified Cookbook.Essential.Meta as Cm

import qualified Cookbook.Ingredients.Lists.Modify as Md
import System.IO
import System.Environment
import System.Exit

-- | Displayed from the "help" request in dispatch.
allArgs = [("Add a Quill","add x to y as z | add x to y | add x as table | add x as list"),
           ("Remove a Quill","remove x from y | remove x"),
           ("Change a Quill","change x in y to z"),
           ("Get a quill", "get x from y | get x | list"),
           ("Combine Quills", "map x to y as z | combine x with y as z")]
          
-- | Dispatches the command line arguments.
main = do
  arguments <- getArgs
  database  <- Qm.fromFile (head arguments)
  dispatch database (head arguments) (tail arguments)
  putStrLn "Done"

-- | Wraps a Quill error in the database by exiting, preventing database corruption.
qError :: Qm.QuillStatus a -> IO a
qError x = case x of
  (Qm.QuillSuccess a)  -> return a -- FIXME make this handle the cases, not complain about them.
  (Qm.QuillMultiple a) -> do
    putStrLn ("Multiple " ++ a ++ " exist in file. Exiting. Fix manually")
    exitFailure
  (Qm.QuillMissing a)  -> do
    putStrLn (a ++ " Missing from file. Exiting. Fix manually.")
    exitFailure

-- | Handles the command-line arguments with destructuring.
dispatch :: [Qm.Quill] -> String -> [String] -> IO ()
dispatch database fName ("change":x:"in":y:"to":z:w) = do
  qu <- qError (Qm.getQuill database y)
  case (snd qu) of
    (Qm.Table c) -> do
      myDB <- (qError (Qm.changeItem database (Qm.ATable (y,x,z))))
      Qm.toFile fName myDB
    (Qm.List c)  -> do
      mod <- qError $ Qm.removeItem database (y,x) -- FIXME make QuillAddition work for lists.
      myDB <- (qError (Qm.addItem mod (Qm.AList (y,z))))
      Qm.toFile fName myDB
  dispatch database fName w

dispatch database fName ("add":x:"to":y:"as":z:w) = do
  myDB <- (qError (Qm.addItem database (Qm.ATable (y,z,x))))
  Qm.toFile fName myDB
  dispatch database fName w

dispatch database fName ("add":x:"to":y:z) = do
  myDB <- (qError (Qm.addItem database (Qm.AList (y,x))))
  Qm.toFile fName myDB
  dispatch database fName z

dispatch database fName ("add":x:"as":y:w) = do
  fl <- Cm.filelines fName
  writeFile fName (unlines ((y ++ "(" ++ x ++ "){}"):fl))
  dispatch database fName w
  
dispatch database fName ("remove":x:"from":y:z) = do
  myDB <- qError (Qm.removeItem database (y,x))
  Qm.toFile fName $ myDB
  dispatch database fName z

dispatch database fName ("remove":x:y) = do
  Qm.toFile fName (Qm.removeQuill database x)
  dispatch database fName y

dispatch database fName ("get":x:"from":y:z) = do
  (qError $ Qm.lookUp database (y,x)) >>= putStrLn 
  dispatch database fName z

dispatch database fName ("get":x:y) = do
  myDB <- (qError (Qm.getQuill database x))
  case (snd myDB) of
    (Qm.List a) -> mapM_ putStrLn (map ppTable [(show fi,se) | fi <- [0..length a], se <- a])
    (Qm.Table a) -> mapM_ putStrLn (map ppTable a)
  dispatch database fName y

dispatch database fName ("list":y) = do
  mapM_ listOff database

-- Composite functions
dispatch database fName ("map":x:"to":y:"as":w:z) = do
  l1 <- qError (Qm.getQuill database x)
  l2 <- qError (Qm.getQuill database y)
  let l1list = case (snd l1) of
        (Qm.List a)  -> a
        (Qm.Table _) -> error "Error! Attempting to map table"
  let l2list = case (snd l2) of
        (Qm.List a)  -> a
        (Qm.Table _) -> error "Error! Attempting to map table"
  Qm.toFile fName ((w,Qm.Table (zip l1list l2list)):database)
  dispatch database fName z

dispatch database fName ("combine":x:"with":y:"as":w:z) = do
  l1 <- qError (Qm.getQuill database x)
  l2 <- qError (Qm.getQuill database y)
  case snd l1 of
    (Qm.List a)  -> case (snd l2) of
      (Qm.List b)  -> Qm.toFile fName ((w,Qm.List (b ++ a)):database)
      (Qm.Table b) -> error "Error! Attempted to combine a table and list"
    (Qm.Table a) -> case (snd l2) of
      (Qm.Table b) -> Qm.toFile fName ((w,Qm.Table (b ++ a)):database)
      (Qm.List b)  -> error "Error! Attempted to combine a table and list"
  dispatch database fName z

dispatch database fname ("file":y:z) = do
  fl <- Cm.filelines y
  cDispatch database fname (map (`Md.splitOn` ' ') fl)
  dispatch database fname z

  
dispatch database fname ("repl":_) = do
  repl fname database
  
dispatch database fName ("help":y) = do
  mapM_ putStrLn (map ppTable allArgs)
  dispatch database fName y
  
dispatch _ _ [] = return ()
dispatch fName db ("and":xs) = dispatch fName db xs
dispatch fName db (x:xs) = do
  putStrLn ("Did not recognize command: "++x)
  dispatch fName db xs

cDispatch _ _ [] = return ()
cDispatch db fname (x:y) = do
  dispatch db fname x
  nDB <- Qm.fromFile fname
  cDispatch nDB fname y
  
-- | Pretty print a table.
ppTable :: (String, String) -> String
ppTable (a,b) = Cm.flt [a," : ",b]

-- | List the contents of a Quill.
listOff :: Qm.Quill -> IO ()
listOff x = case (snd x) of
  (Qm.Table _) -> putStrLn $ "Table " ++ (fst x)
  (Qm.List _)  -> putStrLn $ "List " ++ (fst x)

-- | Evaluate Quill commands in an interactive Read-eval-print loop.
repl :: String -> [Qm.Quill] -> IO ()
repl fname dbase = do
  inp <- Cm.prompt "$ "
  dispatch dbase fname (Md.splitOn inp ' ')
  x <- Qm.fromFile fname
  repl fname x