summaryrefslogtreecommitdiffstats
path: root/src/MdBlocks
diff options
context:
space:
mode:
Diffstat (limited to 'src/MdBlocks')
-rw-r--r--src/MdBlocks/Address.hs20
-rw-r--r--src/MdBlocks/CLI.hs59
-rw-r--r--src/MdBlocks/Repository.hs26
-rw-r--r--src/MdBlocks/Resolver.hs26
4 files changed, 39 insertions, 92 deletions
diff --git a/src/MdBlocks/Address.hs b/src/MdBlocks/Address.hs
index 8a32e0f..25ef26f 100644
--- a/src/MdBlocks/Address.hs
+++ b/src/MdBlocks/Address.hs
@@ -12,9 +12,10 @@ import qualified Data.Text as T
import MdBlocks.Types
-data Address
- = GlobalId Text
- | FileAddress FilePath Text
+data Address = Address
+ { addressFile :: FilePath
+ , addressId :: Text
+ }
deriving (Show, Eq)
parseAddress :: String -> Either String Address
@@ -22,22 +23,23 @@ parseAddress input =
case T.breakOn "#" (T.pack input) of
(file, ident)
| T.null file ->
- Left "address must contain a file path"
+ Left "address must contain a file path before '#'"
| T.null ident ->
Left "address must contain a block id after '#'"
| otherwise ->
Right
- (FileAddress
- (T.unpack file)
- (T.drop 1 ident))
+ Address
+ { addressFile = T.unpack file
+ , addressId = T.drop 1 ident
+ }
addressOf :: Block -> Text
addressOf b =
case mdId (blockMeta b) of
- Just x ->
- T.pack (blockFile b) <> "#" <> x
+ Just ident ->
+ T.pack (blockFile b) <> "#" <> ident
Nothing ->
T.pack (blockFile b)
diff --git a/src/MdBlocks/CLI.hs b/src/MdBlocks/CLI.hs
index 94dbae6..5c2bc29 100644
--- a/src/MdBlocks/CLI.hs
+++ b/src/MdBlocks/CLI.hs
@@ -5,11 +5,13 @@ module MdBlocks.CLI where
import qualified Data.Aeson.Encode.Pretty as JSON
import qualified Data.ByteString.Lazy.Char8 as BL
import qualified Data.Text.IO as T
+import System.Directory (doesFileExist)
+import System.Exit (die)
import Options.Applicative
import MdBlocks.Address
-import MdBlocks.Repository
+import MdBlocks.Parser
import MdBlocks.Resolver
import MdBlocks.Types
@@ -64,45 +66,32 @@ run (List fp) = do
BL.putStrLn $
JSON.encodePretty bs
-run (Extract rawAddr) =
- case parseAddress rawAddr of
+run (Extract rawAddress) =
+ case parseAddress rawAddress of
Left err ->
- failWith err
+ die ("mdblocks: " ++ err)
- Right addr ->
- extractBlock addr
+ Right address -> do
+ isFile <- doesFileExist (addressFile address)
-run (ShowMeta addr) =
- putStrLn ("show not implemented yet: " ++ addr)
-
-extractBlock :: Address -> IO ()
-extractBlock addr = do
- let fp =
- case addr of
- FileAddress file _ ->
- file
-
- GlobalId _ ->
- error "global block addresses are not supported by --extract"
+ if not isFile
+ then
+ die ("mdblocks: not a file: " ++ addressFile address)
+ else do
+ blocks <- loadBlocks (addressFile address)
- blocks <- loadBlocks fp
+ case resolveBlock address blocks of
+ Nothing ->
+ die ("mdblocks: block not found: " ++ rawAddress)
- case resolveBlock addr blocks of
- Nothing ->
- failWith
- ("block not found: " ++ showAddress addr)
+ Just block ->
+ T.putStr (blockContent block)
- Just block ->
- T.putStr (blockContent block)
-
-failWith :: String -> IO ()
-failWith msg = do
- putStrLn ("mdblocks: " ++ msg)
- fail msg
+run (ShowMeta addr) =
+ putStrLn ("show not implemented yet: " ++ addr)
-showAddress :: Address -> String
-showAddress (GlobalId ident) =
- "#" ++ show ident
-showAddress (FileAddress fp ident) =
- fp ++ "#" ++ show ident
+loadBlocks :: FilePath -> IO [Block]
+loadBlocks fp = do
+ txt <- T.readFile fp
+ pure (parseFile fp txt)
diff --git a/src/MdBlocks/Repository.hs b/src/MdBlocks/Repository.hs
deleted file mode 100644
index 9bacaf2..0000000
--- a/src/MdBlocks/Repository.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module MdBlocks.Repository where
-
-import Data.Text.IO as T
-import System.Directory
-
-import MdBlocks.Parser
-import MdBlocks.Types
-
-loadBlocks :: FilePath -> IO [Block]
-loadBlocks fp = do
- txt <- T.readFile fp
- pure (parseFile fp txt)
-
-findMarkdownFiles :: FilePath -> IO [FilePath]
-findMarkdownFiles root = do
- xs <- listDirectory root
- pure
- [ root <> "/" <> x
- | x <- xs
- , takeExtension x == ".md"
- ]
- where
- takeExtension =
- reverse . takeWhile (/='.') . reverse
diff --git a/src/MdBlocks/Resolver.hs b/src/MdBlocks/Resolver.hs
index c6e94d1..29c1658 100644
--- a/src/MdBlocks/Resolver.hs
+++ b/src/MdBlocks/Resolver.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
-
module MdBlocks.Resolver
( resolveBlock
)
@@ -14,26 +12,10 @@ resolveBlock
:: Address
-> [Block]
-> Maybe Block
-
-resolveBlock (GlobalId ident) blocks =
- findById ident blocks
-
-resolveBlock (FileAddress fp ident) blocks =
- findByFileAndId fp ident blocks
-
-findById :: Text -> [Block] -> Maybe Block
-findById ident =
- go
- where
- go [] =
- Nothing
-
- go (b:bs)
- | mdId (blockMeta b) == Just ident =
- Just b
-
- | otherwise =
- go bs
+resolveBlock address =
+ findByFileAndId
+ (addressFile address)
+ (addressId address)
findByFileAndId
:: FilePath