Skip to content

Commit 5b40191

Browse files
committed
Fix Freckle.App.Env for envparse-0.5.2+
I think we can do better here, but for now I just did the quickest CPP to get it compiling.
1 parent 4266ca4 commit 5b40191

File tree

1 file changed

+14
-2
lines changed
  • freckle-env/library/Freckle/App

1 file changed

+14
-2
lines changed

freckle-env/library/Freckle/App/Env.hs

+14-2
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE CPP #-}
2+
13
-- | Parse the shell environment for configuration
24
--
35
-- A minor extension of [envparse](https://hackage.haskell.org/package/envparse).
@@ -38,15 +40,21 @@ module Freckle.App.Env
3840
import Prelude
3941

4042
import Control.Error.Util (note)
41-
import Data.Bifunctor (first, second)
4243
import Data.Char (isDigit)
4344
import Data.Text (Text)
4445
import Data.Text qualified as T
4546
import Data.Time (UTCTime, defaultTimeLocale, parseTimeM)
46-
import Env hiding (flag)
4747
import Env qualified
4848
import Prelude qualified as Unsafe (read)
4949

50+
#if MIN_VERSION_envparse(0,5,2)
51+
import Data.Bifunctor (second)
52+
import Env hiding (eitherReader, flag)
53+
#else
54+
import Data.Bifunctor (first, second)
55+
import Env hiding (flag)
56+
#endif
57+
5058
-- | Designates the value of a parameter when a flag is not provided.
5159
newtype Off a = Off a
5260

@@ -83,9 +91,13 @@ flag (Off f) (On t) n m = Env.flag f t n m
8391
--
8492
-- This is a building-block for other 'Reader's
8593
eitherReader :: (String -> Either String a) -> Env.Reader Error a
94+
#if MIN_VERSION_envparse(0,5,2)
95+
eitherReader = Env.eitherReader
96+
#else
8697
eitherReader f s = first (unread . suffix) $ f s
8798
where
8899
suffix x = x <> ": " <> show s
100+
#endif
89101

90102
-- | Read a time value using the given format
91103
--

0 commit comments

Comments
 (0)