diff options
| -rw-r--r-- | app/Main.hs | 88 |
1 files changed, 59 insertions, 29 deletions
diff --git a/app/Main.hs b/app/Main.hs index 41b81d0..321cf4c 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -35,7 +35,7 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.Text.IO qualified as T import Data.Time.Clock (UTCTime, getCurrentTime) -import Data.Time.Format.ISO8601 (iso8601Show) +import Data.Time.Format.ISO8601 (iso8601ParseM, iso8601Show) import Debug.Trace import GHC.Conc (getNumProcessors) import GHC.Generics (Generic) @@ -606,37 +606,67 @@ applyTags tags' doc = do first (map (\tagKey -> G.tag tagKey Nothing)) $ partitionEithers tags' +data AddTagException = AddTagException G.Tag + deriving (Show) + +instance Exception AddTagException + addTags :: [G.Tag] -> Document -> Document -addTags tags doc = - doc - { index = - doc.index - { tags = doc.index.tags `S.union` (S.fromList tags) - } - } +addTags = + flip (foldl (flip addTag)) + +addTag :: G.Tag -> Document -> Document +addTag tag doc = + if + | G.tagKey tag == "todo" -> + doc {index = doc.index {todo = True}} + | G.tagKey tag == "addedAt" -> + maybe + (throw (AddTagException tag)) + ( \addedAt -> + doc {index = doc.index {addedAt = addedAt}} + ) + (iso8601ParseM . T.unpack =<< (G.tagValue tag)) + | G.tagKey tag == "language" -> + throw (AddTagException tag) + | otherwise -> + doc + { index = + doc.index + { tags = G.replace tag doc.index.tags + } + } + +data RemoveTagException = RemoveTagException G.Tag + deriving (Show) + +instance Exception RemoveTagException removeTags :: [G.Tag] -> Document -> Document -removeTags tags doc = - doc - { index = - doc.index - { tags = - S.filter - ( \tag' -> - ( not $ - any - ( \tag -> - maybe - (G.tagKey tag' == G.tagKey tag) - (\_ -> tag' == tag) - (G.tagValue tag) - ) - tags - ) - ) - doc.index.tags - } - } +removeTags = + flip (foldl (flip removeTag)) + +removeTag :: G.Tag -> Document -> Document +removeTag tag doc = + if + | G.tagKey tag == "todo" -> + doc {index = doc.index {todo = False}} + | G.tagKey tag == "addedAt" -> + throw (RemoveTagException tag) + | G.tagKey tag == "language" -> + throw (RemoveTagException tag) + | otherwise -> + doc + { index = + doc.index + { tags = + maybe + (G.deleteAll (G.tagKey tag)) + (\_ -> G.delete tag) + (G.tagValue tag) + doc.index.tags + } + } tagDocumentInteractively :: S.Settings -> [Document] -> Document -> IO Document tagDocumentInteractively settings allDocs doc = do |