64 lines
1.5 KiB
Haskell
64 lines
1.5 KiB
Haskell
{-# LANGUAGE RecordWildCards, ViewPatterns #-}
|
|
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
|
|
|
|
module Pretty
|
|
( Pretty
|
|
, pretty
|
|
, pprint
|
|
) where
|
|
|
|
import Types
|
|
import Data.List (intercalate)
|
|
import System.FilePath (takeBaseName)
|
|
|
|
|
|
class Pretty a where
|
|
pretty :: a -> String
|
|
|
|
pprint :: Pretty a => a -> IO ()
|
|
pprint = putStrLn . pretty
|
|
|
|
names :: [(Name, String)]
|
|
names =
|
|
[ (Left "acct", "username" )
|
|
, (Left "srvr", "url" )
|
|
, (Left "cdat", "created" )
|
|
, (Left "mdat", "last change")
|
|
, (Left "desc", "description")
|
|
]
|
|
|
|
|
|
instance Pretty Keychain where
|
|
pretty = intercalate spacer . map pretty
|
|
where spacer = '\n' : replicate 57 '~' ++ "\n\n"
|
|
|
|
instance Pretty Item where
|
|
pretty Item {..} = unlines $
|
|
[ "name: " ++ pretty title
|
|
, "content: " ++ password
|
|
, "keychain: " ++ takeBaseName keychain
|
|
, "class: " ++ show itemClass
|
|
, "info: "
|
|
] ++ map pretty entries
|
|
where
|
|
title = maybe (Str "") id (lookup (Right 7) attrs)
|
|
entries = filter ((`elem` keys) . fst) attrs
|
|
keys = map fst names
|
|
password = if length content < 45
|
|
then content
|
|
else take 45 content ++ "..."
|
|
|
|
instance Pretty Attrib where
|
|
pretty (n,v) = " " ++ pretty n ++ ": "++ pretty v
|
|
|
|
instance Pretty Name where
|
|
pretty (flip lookup names -> Just x) = x
|
|
pretty (Left x) = x
|
|
pretty (Right x) = show x
|
|
|
|
instance Pretty Value where
|
|
pretty (Date x) = show x
|
|
pretty (Num x) = show x
|
|
pretty (Str x) = x
|
|
pretty Null = ""
|