import Control.Monad.State
import Data.List (sortBy, nub)
import System.Environment (getArgs, getProgName)
import System.Directory (doesFileExist)
import System.IO (openFile, hGetContents, hClose, IOMode(..),
    Handle, hPutStrLn)

-- for storing dates
data Date = Date Integer Int Int deriving (Show, Read, Eq, Ord)

-- for storing database items
data Item = Item    {description :: String
                    ,category    :: [String]
                    ,date        :: Date
                    ,optional    :: [String]}
                    deriving (Show, Read)

-- a state monad transformer which wraps IO actions.
-- the database (state) is passed implicitly between functions.
type ItemList a = StateT [Item] IO a

-- add an item to the database
addItem :: Item -> ItemList ()
addItem i = modify (++ [i])

-- get the newest of a list of items
latest :: [Item] -> [Item]
latest [] = []
latest [x]= [x]
latest xs = take 1 $ sortBy newer xs

-- compare two items to see which one is newer
newer :: Item -> Item -> Ordering
newer a b = compare (date b) (date a)

-- list all different categories (no duplicates)
categories :: ItemList [String]
categories = liftM (nub . concatMap category) get

-- list only the items with the given category tag
filterByCategory :: String -> ItemList [Item]
filterByCategory c = liftM (filter (\i -> c `elem` category i)) get

-- get the newest of all items
lastOfAll :: ItemList [Item]
lastOfAll = liftM latest get

-- get the newest item in each category
latestByCategory :: ItemList [Item]
latestByCategory = do
    cats <- categories
    filt <- mapM filterByCategory cats
    return $ concatMap latest filt

-- sort all items chronologically, newest first
sortByDate :: ItemList [Item]
sortByDate = liftM (sortBy newer) get

toScreen :: Item -> IO ()
toScreen (Item desc cats (Date y m d) opt) = putStrLn $
    "Description:\t" ++ desc ++ "\nCategories:\t" ++ show cats ++
    "\nDate:\t\t" ++ show y ++ "-" ++ show m ++ "-" ++ show d ++
    "\nOther info:\t" ++ show opt

-- command line argument handling
-- if the user called the program with the option "add", the
-- new item is returned to main so that it can be saved to disk.
-- the argument "opt" is a list.
arguments :: ItemList [Item]
arguments = do
    args <- liftIO getArgs
    case args of
        ("add":desc:cat:year:month:day:opt) -> do
            let newItem = parseItem args
            addItem newItem
            return [newItem]
        ("latest":[]) -> do
            item <- lastOfAll
            lift $ mapM_ toScreen item
            return []
        ("category":[]) -> do
            items <- latestByCategory
            lift $ mapM_ toScreen items
            return []
        ("all":[]) -> do
            sorted <- sortByDate
            lift $ mapM_ toScreen sorted
            return []
        _ -> do
            lift usage
            return []

parseItem :: [String] -> Item
parseItem (_:desc:cat:year:month:day:opt) =
    Item {description = desc, category = words cat,
        date = Date (read year) (read month) (read day),
        optional = opt}

usage :: IO ()
usage = do
    progName <- getProgName
    putStrLn $ "Usage: " ++ progName ++ " add|all|category|latest \
        \OPTIONS\n\nadd \"description\" \"category1 category2\"... \
        \year month day [\"note1\" \"note2\"...]\n\tAdds a new record \
        \to the database.\n\nall\n\tPrints all items in chronological \
        \order.\n\ncategory\n\tPrints the latest item for each category.\
        \\n\nlatest\n\tPrints the latest item."

-- the program creates, reads and writes to a file in the current directory
main :: IO ()
main = do
    progName <- getProgName
    let fileName = progName ++ ".db"
    e <- doesFileExist fileName
    if e
        then do
            hr <- openFile fileName ReadMode
            f <- hGetContents hr
            v <- evalStateT arguments (map read $ lines f)
            hClose hr -- must be called after working with contents!
            hw <- openFile fileName AppendMode
            mapM_ (hPutStrLn hw . show) v
            hClose hw
        else do
            v <- evalStateT arguments []
            hw <- openFile fileName WriteMode
            mapM_ (hPutStrLn hw . show) v
            hClose hw