forked from srid/neuron
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request srid#119 from srid/zettel-grouping
Group zettels by matching tag
- Loading branch information
Showing
8 changed files
with
152 additions
and
43 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,34 +1,71 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE GADTs #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {-# LANGUAGE QuasiQuotes #-} | ||
| {-# LANGUAGE Rank2Types #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| {-# LANGUAGE ViewPatterns #-} | ||
| {-# LANGUAGE NoImplicitPrelude #-} | ||
|
|
||
| module Neuron.Zettelkasten.Link.Theme where | ||
| module Neuron.Zettelkasten.Link.Theme | ||
| ( ZettelsView (..), | ||
| ZettelView, | ||
| LinkTheme (..), | ||
| zettelsViewFromURI, | ||
| linkThemeFromURI, | ||
| ) | ||
| where | ||
|
|
||
| import Control.Monad.Except | ||
| import Relude | ||
| import qualified Text.URI as URI | ||
| import Text.URI.QQ (queryKey) | ||
|
|
||
| data ZettelsView = ZettelsView | ||
| { zettelsViewLinkTheme :: LinkTheme, | ||
| zettelsViewGroupByTag :: Bool | ||
| } | ||
| deriving (Eq, Show, Ord) | ||
|
|
||
| type ZettelView = LinkTheme | ||
|
|
||
| data LinkTheme | ||
| = LinkTheme_Default | ||
| | LinkTheme_Simple | ||
| | LinkTheme_WithDate | ||
| deriving (Eq, Show, Ord) | ||
|
|
||
| -- TODO: MonadError | ||
| linkThemeFromURI :: HasCallStack => URI.URI -> LinkTheme | ||
| zettelsViewFromURI :: MonadError Text m => URI.URI -> m ZettelsView | ||
| zettelsViewFromURI uri = | ||
| ZettelsView | ||
| <$> linkThemeFromURI uri | ||
| <*> pure (hasQueryFlag [queryKey|grouped|] uri) | ||
|
|
||
| linkThemeFromURI :: MonadError Text m => URI.URI -> m LinkTheme | ||
| linkThemeFromURI uri = | ||
| fromMaybe LinkTheme_Default $ listToMaybe $ flip mapMaybe (URI.uriQuery uri) $ \case | ||
| fmap (fromMaybe LinkTheme_Default) $ case getQueryParam [queryKey|linkTheme|] uri of | ||
| Just "default" -> pure $ Just LinkTheme_Default | ||
| Just "simple" -> pure $ Just LinkTheme_Simple | ||
| Just "withDate" -> pure $ Just LinkTheme_WithDate | ||
| Nothing -> pure Nothing | ||
| _ -> throwError "Invalid value for linkTheme" | ||
|
|
||
| getQueryParam :: URI.RText 'URI.QueryKey -> URI.URI -> Maybe Text | ||
| getQueryParam k uri = | ||
| listToMaybe $ catMaybes $ flip fmap (URI.uriQuery uri) $ \case | ||
| URI.QueryFlag _ -> Nothing | ||
| URI.QueryParam (URI.unRText -> key) (URI.unRText -> val) -> | ||
| case key of | ||
| "linkTheme" -> | ||
| case val of | ||
| "default" -> Just LinkTheme_Default | ||
| "simple" -> Just LinkTheme_Simple | ||
| "withDate" -> Just LinkTheme_WithDate | ||
| _ -> error $ "Unknown link theme: " <> val | ||
| _ -> Nothing | ||
| URI.QueryParam key (URI.unRText -> val) -> | ||
| if key == k | ||
| then Just val | ||
| else Nothing | ||
|
|
||
| hasQueryFlag :: URI.RText 'URI.QueryKey -> URI.URI -> Bool | ||
| hasQueryFlag k uri = | ||
| fromMaybe False $ listToMaybe $ catMaybes $ flip fmap (URI.uriQuery uri) $ \case | ||
| URI.QueryFlag key -> | ||
| if key == k | ||
| then Just True | ||
| else Nothing | ||
| _ -> Nothing |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,34 @@ | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {-# LANGUAGE RankNTypes #-} | ||
| {-# LANGUAGE NoImplicitPrelude #-} | ||
|
|
||
| module Neuron.Zettelkasten.Link.ThemeSpec | ||
| ( spec, | ||
| ) | ||
| where | ||
|
|
||
| import Neuron.Zettelkasten.Link.Theme | ||
| import Relude | ||
| import Test.Hspec | ||
| import Text.URI (URI, mkURI) | ||
|
|
||
| spec :: Spec | ||
| spec = | ||
| describe "Link theme extraction from URI" $ do | ||
| it "Parse basic link theme" $ do | ||
| parseURIWith linkThemeFromURI "zquery://search?linkTheme=default" | ||
| `shouldBe` Right LinkTheme_Default | ||
| parseURIWith linkThemeFromURI "zquery://search?linkTheme=withDate" | ||
| `shouldBe` Right LinkTheme_WithDate | ||
| parseURIWith linkThemeFromURI "zcfquery://search?linkTheme=simple" | ||
| `shouldBe` Right LinkTheme_Simple | ||
| it "Parse grouped query flag" $ do | ||
| parseURIWith zettelsViewFromURI "zquery://search?tag=foo&grouped" | ||
| `shouldBe` Right (ZettelsView LinkTheme_Default True) | ||
| parseURIWith zettelsViewFromURI "zquery://search?tag=foo" | ||
| `shouldBe` Right (ZettelsView LinkTheme_Default False) | ||
| where | ||
| parseURIWith :: (URI -> Either Text a) -> Text -> Either Text a | ||
| parseURIWith f = | ||
| either (Left . toText . displayException) f . mkURI |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters