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#117 from srid/query-refactor
Refactor query types
- Loading branch information
Showing
18 changed files
with
300 additions
and
170 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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,3 +1,3 @@ | ||
| #!/usr/bin/env bash | ||
| set -xe | ||
| nix-shell --run "ghcid -c 'cabal new-repl exe:neuron' -T \":main $*\"" | ||
| nix-shell --pure --run "ghcid -c 'cabal new-repl exe:neuron' -T \":main $*\"" |
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,3 +1,3 @@ | ||
| #!/usr/bin/env bash | ||
| set -xe | ||
| nix-shell --run "ghcid -c 'cabal new-repl test:neuron-test' -T \":main $*\"" | ||
| nix-shell --pure --run "ghcid $* -c 'cabal new-repl test:neuron-test' -T \":main $*\"" |
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
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,60 +1,92 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE GADTs #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {-# LANGUAGE OverloadedStrings #-} | ||
| {-# LANGUAGE Rank2Types #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| {-# LANGUAGE StandaloneDeriving #-} | ||
| {-# LANGUAGE TupleSections #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE NoImplicitPrelude #-} | ||
|
|
||
| -- | Special Zettel links in Markdown | ||
| module Neuron.Zettelkasten.Link where | ||
|
|
||
| import Control.Monad.Except | ||
| import Data.Some | ||
| import Neuron.Zettelkasten.ID | ||
| import Neuron.Zettelkasten.Link.Theme | ||
| import Neuron.Zettelkasten.Markdown (MarkdownLink (..)) | ||
| import Neuron.Zettelkasten.Query (Query (..), queryFromURI, runQuery) | ||
| import Neuron.Zettelkasten.Query (Query (..), queryFromMarkdownLink, runQuery) | ||
| import Neuron.Zettelkasten.Store | ||
| import Neuron.Zettelkasten.Tag | ||
| import Neuron.Zettelkasten.Zettel | ||
| import Relude | ||
| import qualified Text.URI as URI | ||
|
|
||
| -- | A ZLink is a special link supported by Neuron | ||
| -- | ||
| -- z:, zcf:, zquery: and zcfquery: | ||
| data ZLink | ||
| = ZLink_ConnectZettel Connection ZettelID | ||
| | -- | Render a list (or should it be tree?) of links to queries zettels | ||
| ZLink_QueryZettels Connection LinkTheme [Query] | ||
| deriving (Eq, Show) | ||
|
|
||
| mkZLink :: HasCallStack => MarkdownLink -> Maybe ZLink | ||
| mkZLink MarkdownLink {markdownLinkUri = uri, markdownLinkText = linkText} = | ||
| -- NOTE: We should probably drop the 'cf' variants in favour of specifying | ||
| -- the connection type as a query param or something. | ||
| case fmap URI.unRText (URI.uriScheme uri) of | ||
| Just "z" -> | ||
| -- The inner link text is supposed to be the zettel ID | ||
| let zid = parseZettelID linkText | ||
| in Just $ ZLink_ConnectZettel Folgezettel zid | ||
| Just "zcf" -> | ||
| -- The inner link text is supposed to be the zettel ID | ||
| let zid = parseZettelID linkText | ||
| in Just $ ZLink_ConnectZettel OrdinaryConnection zid | ||
| Just "zquery" -> | ||
| Just $ ZLink_QueryZettels Folgezettel (linkThemeFromURI uri) (either error id $ queryFromURI uri) | ||
| Just "zcfquery" -> | ||
| Just $ ZLink_QueryZettels OrdinaryConnection (linkThemeFromURI uri) (either error id $ queryFromURI uri) | ||
| _ -> do | ||
| let uriS = URI.render uri | ||
| guard $ uriS == linkText | ||
| zid <- rightToMaybe $ parseZettelID' uriS | ||
| pure $ ZLink_ConnectZettel Folgezettel zid | ||
|
|
||
| -- | The connections referenced in a zlink. | ||
| zLinkConnections :: ZettelStore -> ZLink -> [(Connection, ZettelID)] | ||
| zLinkConnections store = \case | ||
| ZLink_ConnectZettel conn zid -> | ||
| type family QueryConnection q | ||
|
|
||
| type instance QueryConnection Zettel = Connection | ||
|
|
||
| type instance QueryConnection [Zettel] = Connection | ||
|
|
||
| type instance QueryConnection [Tag] = () | ||
|
|
||
| type family QueryViewTheme q | ||
|
|
||
| type instance QueryViewTheme Zettel = LinkTheme | ||
|
|
||
| type instance QueryViewTheme [Zettel] = LinkTheme | ||
|
|
||
| type instance QueryViewTheme [Tag] = () | ||
|
|
||
| -- TODO: Refactor to be a GADT using Some, and derive GEq, etc. correctly | ||
| data NeuronLink | ||
| = forall r. | ||
| (Show (Query r), Show (QueryConnection r), Show (QueryViewTheme r)) => | ||
| NeuronLink (Query r, QueryConnection r, QueryViewTheme r) | ||
|
|
||
| deriving instance Show NeuronLink | ||
|
|
||
| instance Eq NeuronLink where | ||
| (==) (NeuronLink (Query_ZettelByID zid1, c1, t1)) (NeuronLink (Query_ZettelByID zid2, c2, t2)) = | ||
| and [zid1 == zid2, c1 == c2, t1 == t2] | ||
| (==) (NeuronLink (Query_ZettelsByTag p1, c1, t1)) (NeuronLink (Query_ZettelsByTag p2, c2, t2)) = | ||
| and [p1 == p2, c1 == c2, t1 == t2] | ||
| (==) (NeuronLink (Query_Tags p1, c1, t1)) (NeuronLink (Query_Tags p2, c2, t2)) = | ||
| and [p1 == p2, c1 == c2, t1 == t2] | ||
| (==) _ _ = | ||
| False | ||
|
|
||
| neuronLinkFromMarkdownLink :: MonadError Text m => MarkdownLink -> m (Maybe NeuronLink) | ||
| neuronLinkFromMarkdownLink ml@MarkdownLink {markdownLinkUri = uri} = do | ||
| queryFromMarkdownLink ml >>= \case | ||
| Nothing -> pure Nothing | ||
| Just someQ -> Just <$> do | ||
| withSome someQ $ \q -> case q of | ||
| Query_ZettelByID _ -> | ||
| pure $ NeuronLink (q, connectionFromURI uri, linkThemeFromURI uri) | ||
| Query_ZettelsByTag _ -> | ||
| pure $ NeuronLink (q, connectionFromURI uri, linkThemeFromURI uri) | ||
| Query_Tags _ -> | ||
| pure $ NeuronLink (q, (), ()) | ||
|
|
||
| neuronLinkConnections :: ZettelStore -> NeuronLink -> [(Connection, ZettelID)] | ||
| neuronLinkConnections store = \case | ||
| NeuronLink (Query_ZettelByID zid, conn, _) -> | ||
| [(conn, zid)] | ||
| ZLink_QueryZettels conn _linkTheme q -> | ||
| NeuronLink (q@(Query_ZettelsByTag _pats), conn, _) -> | ||
| (conn,) . zettelID <$> runQuery store q | ||
| _ -> | ||
| [] | ||
|
|
||
| connectionFromURI :: URI.URI -> Connection | ||
| connectionFromURI uri = | ||
| fromMaybe Folgezettel $ | ||
| case fmap URI.unRText (URI.uriScheme uri) of | ||
| Just scheme | ||
| | scheme `elem` ["zcf", "zcfquery"] -> | ||
| Just OrdinaryConnection | ||
| _ -> | ||
| 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
Oops, something went wrong.