-----------------------------------------------------------------------------
-- |
-- Module : Entry
-- Copyright : (C) Peter Robinson 2010-2013
-- License : GPL-2
--
-- Maintainer : Peter Robinson <thaldyron@gmail.com>
-- Stability : experimental
-- Portability : portable
--
-----------------------------------------------------------------------------
module Entry
where
import Data.Maybe
import Data.List(intercalate)
import Data.Text.Lazy(Text)
import qualified Data.Text.Lazy as T
import qualified Data.GraphViz.Attributes.HTML as GA
import Data.Text.Lazy.Encoding
import Data.Binary
import Control.Monad(liftM)
data Entry = Entry
{ entryName :: Text
, entryGraduationInfo :: [GraduationInfo]
, entryAdvisors :: [(Text,Text)]
}
deriving(Eq,Ord)
data GraduationInfo = GraduationInfo
{ gradDegree :: Maybe Text
, gradUniversity :: Maybe Text
, gradYear :: Maybe Text
, gradThesis :: Maybe Text
}
deriving(Eq,Ord)
instance Binary Text where
put = put . encodeUtf8
get = liftM decodeUtf8 get
instance Binary Entry where
put (Entry x1 x2 x3) = put x1 >> put x2 >> put x3
get = do
x1 <- get
x2 <- get
x3 <- get
return $ Entry x1 x2 x3
instance Binary GraduationInfo where
put (GraduationInfo x1 x2 x3 x4) = put x1 >> put x2 >> put x3 >> put x4
get = do
x1 <- get
x2 <- get
x3 <- get
x4 <- get
return $ GraduationInfo x1 x2 x3 x4
urlAdvisors :: Entry -> [Text]
urlAdvisors = map (T.pack . (++) "http://genealogy.math.ndsu.nodak.edu/" . T.unpack . snd) . entryAdvisors
instance Show Entry where
show e =
let ginfos = concatMap show (entryGraduationInfo e) in
T.unpack (entryName e)
++ if length ginfos > 2 then "\\n" ++ ginfos else ""
instance Show GraduationInfo where
show g =
let ls = map T.unpack $ catMaybes [gradDegree g, gradUniversity g, gradYear g] in
intercalate ", " ls ++ "\\n" ++ maybeShow (gradThesis g)
where
maybeShow (Just gi) = T.unpack gi
maybeShow Nothing = ""
-- | Transform an `Entry` to plaintext.
entryToText :: Entry -> Text
entryToText e =
let ginfos = T.intercalate (T.pack "\\n") $ map graduationInfoToText (entryGraduationInfo e) in
entryName e `T.append` (if T.length ginfos > 2 then T.pack "\\n" `T.append` ginfos else T.pack "")
graduationInfoToText :: GraduationInfo -> Text
graduationInfoToText g =
let ls = catMaybes [gradDegree g, gradUniversity g, gradYear g] in
T.intercalate (T.pack ", ") ls `T.append` (maybeText (gradThesis g))
where
maybeText (Just gi) = T.pack "\\n" `T.append` gi
maybeText Nothing = T.pack ""
-- | Transform an `Entry` to an HTML-like label.
entryToHtml :: GA.Attributes -- ^ table attributes
-> GA.Attributes -- ^ font options for header
-> GA.Attributes -- ^ font options for body text
-> Entry
-> GA.Label
entryToHtml tableAtts headingAtts fontAtts e =
let ginfos = intercalate [GA.Newline []] $ map graduationInfoToHtml (entryGraduationInfo e) in
GA.Table $ GA.HTable Nothing tableAtts $
(GA.Cells [GA.LabelCell [GA.Align GA.HCenter] $
GA.Text [GA.Font headingAtts [GA.Str (entryName e)]]]) :
[GA.Cells [GA.LabelCell [] $ GA.Text [GA.Font fontAtts ginfos]]
| not $ null ginfos ]
graduationInfoToHtml :: GraduationInfo -> [GA.TextItem]
graduationInfoToHtml g =
let ls = catMaybes [gradDegree g, gradUniversity g, gradYear g]
thesis = maybeText (gradThesis g) in
case (null ls,isNothing $ gradThesis g) of
(True,True) -> []
(True,False) -> [thesis]
(False,True) -> [GA.Str (T.intercalate (T.pack ", ") ls)]
(False,False) -> GA.Str (T.intercalate (T.pack ", ") ls) : (GA.Newline [] : [thesis])
where
maybeText (Just gi) = GA.Str gi
maybeText Nothing = GA.Str $ T.pack ""
removeThesis :: Entry -> Entry
removeThesis e =
e{ entryGraduationInfo = map (\g -> g{ gradThesis = Nothing }) $ entryGraduationInfo e }