scaffolder/src/Text/Edifact/Fetcher/Configuration.hs

   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