Anonymous user
Simple database: Difference between revisions
Simple Database - Haskell
(→{{header|Common Lisp}}: new command options to print all series and timeline of events, some code cleanup) |
(Simple Database - Haskell) |
||
Line 1,180:
}
}</lang>
=={{header|Haskell}}==
The database is a list of type Item stored in a StateT monad transformer that allows for IO actions to be perfomed with it (StateT [Item] IO a). All IO actions occurring inside the StateT monad (handling command line arguments and printing items) must be lifted.
The database is written to disk using "show" and read back using "read". Therefore, Item is declared as an instance of both Show and Read classes. An item in the database file looks like the following:
Item {description = "La traviata", category = ["Classical"], date = Date 2012 10 19, optional = ["Giuseppe Verdi","1853"]}
<lang Haskell>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 $ reverse $ sortBy newer xs
-- compare two items to see which one is newer
newer :: Item -> Item -> Ordering
newer a b = compare (date a) (date b)
-- list all different categories (no duplicates)
categories :: ItemList [String]
categories = do
ix <- get
return $ nub $ concatMap category ix
-- list only the items with the given category tag
filterByCategory :: String -> ItemList [Item]
filterByCategory "" = get
filterByCategory c = do
ix <- get
return $ filter (\i -> c `elem` category i) ix
-- get the newest of all items
lastOfAll :: ItemList [Item]
lastOfAll = do
ix <- get
return $ latest ix
-- 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 = do
ix <- get
return $ reverse $ sortBy newer ix
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
case e of
True -> 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) (map show v)
hClose hw
False -> do
v <- evalStateT arguments []
hw <- openFile fileName WriteMode
mapM_ (hPutStrLn hw) (map show v)
hClose hw
</lang>
=={{header|J}}==
| |||