diff options
author | Kierán Meinhardt <kmein@posteo.de> | 2024-10-13 09:55:20 +0200 |
---|---|---|
committer | Kierán Meinhardt <kmein@posteo.de> | 2024-10-13 09:55:24 +0200 |
commit | 962db630a81a4040902c23c773df3069a48db0a3 (patch) | |
tree | 65c2208cd0fe98aa8979080cb22b84edc35253ef /common | |
parent | 895772f1e76d0cdf12eba5a579ce889d585c9072 (diff) |
move Collection types to common
Diffstat (limited to 'common')
-rw-r--r-- | common/common.cabal | 5 | ||||
-rw-r--r-- | common/src/Collection.hs | 31 |
2 files changed, 34 insertions, 2 deletions
diff --git a/common/common.cabal b/common/common.cabal index 738d8be..2c98a47 100644 --- a/common/common.cabal +++ b/common/common.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: common -version: 0.1.0.0 +version: 0.2.0 license: BSD-3-Clause license-file: LICENSE maintainer: aforemny@posteo.de @@ -9,7 +9,8 @@ build-type: Simple extra-doc-files: CHANGELOG.md library - exposed-modules: Version + exposed-modules: Version, + Collection hs-source-dirs: src default-language: GHC2021 default-extensions: ViewPatterns diff --git a/common/src/Collection.hs b/common/src/Collection.hs new file mode 100644 index 0000000..a23fd31 --- /dev/null +++ b/common/src/Collection.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} +module Collection where + +import Data.Text qualified as T +import Text.ParserCombinators.ReadP qualified as R +import Text.ParserCombinators.ReadPrec qualified as R +import Text.Read (Read (..)) + +newtype Collection = Collection {name :: T.Text} + deriving (Read, Eq, Show) + +data CollectionItem = CollectionItem + { collection :: Collection, + itemFileName :: FilePath + } deriving (Eq) + +instance Read CollectionItem where + readPrec = R.lift $ do + (Collection . T.pack -> collection) <- R.munch (/= '/') + _ <- R.string "/" + itemFileName <- do + itemFileName <- R.munch (liftA2 (&&) (/= '.') (/= '/')) + fileExt <- R.string ".json" + pure (itemFileName <> fileExt) + pure CollectionItem {..} + +instance Show CollectionItem where + show (CollectionItem {collection = Collection cn, itemFileName}) = + show (cn <> "/" <> T.pack itemFileName) |