diff options
Diffstat (limited to 'scaffolder/src/Text/Edifact/Fetcher/Configuration.hs')
-rw-r--r-- | scaffolder/src/Text/Edifact/Fetcher/Configuration.hs | 43 |
1 files changed, 43 insertions, 0 deletions
diff --git a/scaffolder/src/Text/Edifact/Fetcher/Configuration.hs b/scaffolder/src/Text/Edifact/Fetcher/Configuration.hs new file mode 100644 index 0000000..a074641 --- /dev/null +++ b/scaffolder/src/Text/Edifact/Fetcher/Configuration.hs | |||
@@ -0,0 +1,43 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | ||
2 | {-# LANGUAGE OverloadedStrings #-} | ||
3 | |||
4 | module Text.Edifact.Fetcher.Configuration | ||
5 | ( -- * Fetching environment | ||
6 | FetchingEnv(..) | ||
7 | -- * Parsing helpers | ||
8 | , readSelectMessages | ||
9 | -- * Shortcuts for reading the environment | ||
10 | , getTargetRevision | ||
11 | , getHome | ||
12 | , getSelectedMessages | ||
13 | ) where | ||
14 | |||
15 | import Text.Edifact.Scaffolder.Commons (MessageCode, Revision, | ||
16 | messageCodeParser) | ||
17 | |||
18 | import Control.Monad.Reader.Class (MonadReader, asks) | ||
19 | import Data.List.NonEmpty (NonEmpty, nonEmpty) | ||
20 | import Text.Parsec (char, parse, sepBy1) | ||
21 | |||
22 | data FetchingEnv = FetchingEnv { fetchingRevision :: Revision | ||
23 | , specificationHome :: FilePath | ||
24 | , selectedMessages :: Maybe (NonEmpty MessageCode) | ||
25 | } | ||
26 | |||
27 | getTargetRevision :: MonadReader FetchingEnv m => m Revision | ||
28 | getTargetRevision = asks fetchingRevision | ||
29 | |||
30 | getHome :: MonadReader FetchingEnv m => m FilePath | ||
31 | getHome = asks specificationHome | ||
32 | |||
33 | getSelectedMessages :: MonadReader FetchingEnv m => m (Maybe (NonEmpty MessageCode)) | ||
34 | getSelectedMessages = asks selectedMessages | ||
35 | |||
36 | readSelectMessages :: Maybe String -> Maybe (NonEmpty MessageCode) | ||
37 | readSelectMessages value = | ||
38 | let tryParse p s = toMaybe . parse p s | ||
39 | toMaybe (Right v) = Just v | ||
40 | toMaybe _ = Nothing | ||
41 | messageCodesParser = messageCodeParser `sepBy1` comma | ||
42 | comma = char ',' | ||
43 | in value >>= tryParse messageCodesParser "" >>= nonEmpty | ||