{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
-- | promoted io functions

module Predicate.Data.IO (
   -- ** file handling

    ReadFile
  , ReadFileBinary
  , FileExists
  , ReadDir
  , DirExists
  , AppendFile
  , WriteFile
  , WriteFile'

  -- ** screen

  , Stdout
  , Stderr
  , Stdin
  , ReadIO
  , ReadIO'

  -- ** environment

  , ReadEnv
  , ReadEnvAll

  -- ** date time

  , TimeUtc
  , TimeZt
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Data.Maybe (IsJust)
import Predicate.Data.Monoid (type (<>))
import Predicate.Data.ReadShow (ReadP)
import GHC.TypeLits (Symbol,KnownSymbol)
import Data.Proxy (Proxy(Proxy))
import qualified Control.Exception as E
import Data.Kind (Type)
import Control.Arrow (ArrowChoice(left))
import Data.Time (UTCTime, ZonedTime, getCurrentTime, getZonedTime)
import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)
import System.IO (hPutStr, withFile, IOMode(WriteMode, AppendMode), stderr)
import System.Environment (getEnvironment, lookupEnv)
import qualified Data.ByteString.Char8 as BS8
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> import Predicate


-- | similar to 'System.IO.readFile'

--

-- >>> pz @(ReadFile "LICENSE" >> 'Just Id >> Len > 0) ()

-- Val True

--

-- >>> pz @(FileExists "xyzzy") ()

-- Val False

--

data ReadFile p deriving Int -> ReadFile p -> ShowS
[ReadFile p] -> ShowS
ReadFile p -> String
(Int -> ReadFile p -> ShowS)
-> (ReadFile p -> String)
-> ([ReadFile p] -> ShowS)
-> Show (ReadFile p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ReadFile p -> ShowS
forall k (p :: k). [ReadFile p] -> ShowS
forall k (p :: k). ReadFile p -> String
showList :: [ReadFile p] -> ShowS
$cshowList :: forall k (p :: k). [ReadFile p] -> ShowS
show :: ReadFile p -> String
$cshow :: forall k (p :: k). ReadFile p -> String
showsPrec :: Int -> ReadFile p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ReadFile p -> ShowS
Show

instance ( PP p x ~ String
         , P p x
         ) => P (ReadFile p) x where
  type PP (ReadFile p) x = Maybe String
  eval :: proxy (ReadFile p) -> POpts -> x -> m (TT (PP (ReadFile p) x))
eval proxy (ReadFile p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ReadFile"
    TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (Maybe String)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT (Maybe String)
e -> TT (Maybe String) -> m (TT (Maybe String))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe String)
e
      Right String
p -> do
        let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
        Maybe (Maybe String)
mb <- IO (Maybe String) -> m (Maybe (Maybe String))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Maybe String) -> m (Maybe (Maybe String)))
-> IO (Maybe String) -> m (Maybe (Maybe String))
forall a b. (a -> b) -> a -> b
$ IO Bool
-> IO (Maybe String) -> IO (Maybe String) -> IO (Maybe String)
forall (m :: Type -> Type) a.
Monad m =>
m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesFileExist String
p)
                          (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
p)
                          IO (Maybe String)
forall a. Monoid a => a
mempty
        TT (Maybe String) -> m (TT (Maybe String))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe String) -> m (TT (Maybe String)))
-> TT (Maybe String) -> m (TT (Maybe String))
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe String)
mb of
          Maybe (Maybe String)
Nothing -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (Maybe String)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
          Just Maybe String
Nothing -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe String -> Val (Maybe String)
forall a. a -> Val a
Val Maybe String
forall a. Maybe a
Nothing) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist") [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
          Just (Just String
b) -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe String -> Val (Maybe String)
forall a. a -> Val a
Val (String -> Maybe String
forall a. a -> Maybe a
Just String
b)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" len=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Just " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
b) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]

-- | similar to 'Data.ByteString.readFile'

data ReadFileBinary p deriving Int -> ReadFileBinary p -> ShowS
[ReadFileBinary p] -> ShowS
ReadFileBinary p -> String
(Int -> ReadFileBinary p -> ShowS)
-> (ReadFileBinary p -> String)
-> ([ReadFileBinary p] -> ShowS)
-> Show (ReadFileBinary p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ReadFileBinary p -> ShowS
forall k (p :: k). [ReadFileBinary p] -> ShowS
forall k (p :: k). ReadFileBinary p -> String
showList :: [ReadFileBinary p] -> ShowS
$cshowList :: forall k (p :: k). [ReadFileBinary p] -> ShowS
show :: ReadFileBinary p -> String
$cshow :: forall k (p :: k). ReadFileBinary p -> String
showsPrec :: Int -> ReadFileBinary p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ReadFileBinary p -> ShowS
Show

instance ( PP p x ~ String
         , P p x
         ) => P (ReadFileBinary p) x where
  type PP (ReadFileBinary p) x = Maybe BS8.ByteString
  eval :: proxy (ReadFileBinary p)
-> POpts -> x -> m (TT (PP (ReadFileBinary p) x))
eval proxy (ReadFileBinary p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ReadFileBinary"
    TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (Maybe ByteString)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT (Maybe ByteString)
e -> TT (Maybe ByteString) -> m (TT (Maybe ByteString))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe ByteString)
e
      Right String
p -> do
        let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
        Maybe (Maybe ByteString)
mb <- IO (Maybe ByteString) -> m (Maybe (Maybe ByteString))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Maybe ByteString) -> m (Maybe (Maybe ByteString)))
-> IO (Maybe ByteString) -> m (Maybe (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ IO Bool
-> IO (Maybe ByteString)
-> IO (Maybe ByteString)
-> IO (Maybe ByteString)
forall (m :: Type -> Type) a.
Monad m =>
m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesFileExist String
p)
                          (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS8.readFile String
p)
                          IO (Maybe ByteString)
forall a. Monoid a => a
mempty
        TT (Maybe ByteString) -> m (TT (Maybe ByteString))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe ByteString) -> m (TT (Maybe ByteString)))
-> TT (Maybe ByteString) -> m (TT (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe ByteString)
mb of
          Maybe (Maybe ByteString)
Nothing -> POpts
-> Val (Maybe ByteString)
-> String
-> [Tree PE]
-> TT (Maybe ByteString)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (Maybe ByteString)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
          Just Maybe ByteString
Nothing -> POpts
-> Val (Maybe ByteString)
-> String
-> [Tree PE]
-> TT (Maybe ByteString)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe ByteString -> Val (Maybe ByteString)
forall a. a -> Val a
Val Maybe ByteString
forall a. Maybe a
Nothing) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist") [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
          Just (Just ByteString
b) -> POpts
-> Val (Maybe ByteString)
-> String
-> [Tree PE]
-> TT (Maybe ByteString)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe ByteString -> Val (Maybe ByteString)
forall a. a -> Val a
Val (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
b)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" len=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS8.length ByteString
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Just " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ByteString -> String
litBS POpts
opts ByteString
b) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]

-- | similar to 'System.Directory.doesFileExist'

data FileExists p deriving Int -> FileExists p -> ShowS
[FileExists p] -> ShowS
FileExists p -> String
(Int -> FileExists p -> ShowS)
-> (FileExists p -> String)
-> ([FileExists p] -> ShowS)
-> Show (FileExists p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> FileExists p -> ShowS
forall k (p :: k). [FileExists p] -> ShowS
forall k (p :: k). FileExists p -> String
showList :: [FileExists p] -> ShowS
$cshowList :: forall k (p :: k). [FileExists p] -> ShowS
show :: FileExists p -> String
$cshow :: forall k (p :: k). FileExists p -> String
showsPrec :: Int -> FileExists p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> FileExists p -> ShowS
Show
type FileExistsT p = ReadFile p >> IsJust

instance P (FileExistsT p) x => P (FileExists p) x where
  type PP (FileExists p) x = PP (FileExistsT p) x
  eval :: proxy (FileExists p) -> POpts -> x -> m (TT (PP (FileExists p) x))
eval proxy (FileExists p)
_ = Proxy (FileExistsT p)
-> POpts -> x -> m (TT (PP (FileExistsT p) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (FileExistsT p)
forall k (t :: k). Proxy t
Proxy @(FileExistsT p))

-- | similar to 'System.Directory.doesDirectoryExist'

--

-- >>> pz @(DirExists ".") ()

-- Val True

--

-- >>> pz @(DirExists "xxy") ()

-- Val False

--

data DirExists p deriving Int -> DirExists p -> ShowS
[DirExists p] -> ShowS
DirExists p -> String
(Int -> DirExists p -> ShowS)
-> (DirExists p -> String)
-> ([DirExists p] -> ShowS)
-> Show (DirExists p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> DirExists p -> ShowS
forall k (p :: k). [DirExists p] -> ShowS
forall k (p :: k). DirExists p -> String
showList :: [DirExists p] -> ShowS
$cshowList :: forall k (p :: k). [DirExists p] -> ShowS
show :: DirExists p -> String
$cshow :: forall k (p :: k). DirExists p -> String
showsPrec :: Int -> DirExists p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> DirExists p -> ShowS
Show
type DirExistsT p = ReadDir p >> IsJust

instance P (DirExistsT p) x => P (DirExists p) x where
  type PP (DirExists p) x = PP (DirExistsT p) x
  eval :: proxy (DirExists p) -> POpts -> x -> m (TT (PP (DirExists p) x))
eval proxy (DirExists p)
_ = Proxy (DirExistsT p) -> POpts -> x -> m (TT (PP (DirExistsT p) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (DirExistsT p)
forall k (t :: k). Proxy t
Proxy @(DirExistsT p))

-- | similar to 'System.Directory.listDirectory'

data ReadDir p deriving Int -> ReadDir p -> ShowS
[ReadDir p] -> ShowS
ReadDir p -> String
(Int -> ReadDir p -> ShowS)
-> (ReadDir p -> String)
-> ([ReadDir p] -> ShowS)
-> Show (ReadDir p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ReadDir p -> ShowS
forall k (p :: k). [ReadDir p] -> ShowS
forall k (p :: k). ReadDir p -> String
showList :: [ReadDir p] -> ShowS
$cshowList :: forall k (p :: k). [ReadDir p] -> ShowS
show :: ReadDir p -> String
$cshow :: forall k (p :: k). ReadDir p -> String
showsPrec :: Int -> ReadDir p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ReadDir p -> ShowS
Show
instance ( PP p x ~ String
         , P p x
         ) => P (ReadDir p) x where
  type PP (ReadDir p) x = Maybe [FilePath]
  eval :: proxy (ReadDir p) -> POpts -> x -> m (TT (PP (ReadDir p) x))
eval proxy (ReadDir p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ReadDir"
    TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (Maybe [String])) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT (Maybe [String])
e -> TT (Maybe [String]) -> m (TT (Maybe [String]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe [String])
e
      Right String
p -> do
        let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
        Maybe (Maybe [String])
mb <- IO (Maybe [String]) -> m (Maybe (Maybe [String]))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Maybe [String]) -> m (Maybe (Maybe [String])))
-> IO (Maybe [String]) -> m (Maybe (Maybe [String]))
forall a b. (a -> b) -> a -> b
$ IO Bool
-> IO (Maybe [String])
-> IO (Maybe [String])
-> IO (Maybe [String])
forall (m :: Type -> Type) a.
Monad m =>
m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesDirectoryExist String
p)
                          ([String] -> Maybe [String]
forall a. a -> Maybe a
Just ([String] -> Maybe [String]) -> IO [String] -> IO (Maybe [String])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
listDirectory String
p)
                          IO (Maybe [String])
forall a. Monoid a => a
mempty
        TT (Maybe [String]) -> m (TT (Maybe [String]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe [String]) -> m (TT (Maybe [String])))
-> TT (Maybe [String]) -> m (TT (Maybe [String]))
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe [String])
mb of
          Maybe (Maybe [String])
Nothing -> POpts
-> Val (Maybe [String])
-> String
-> [Tree PE]
-> TT (Maybe [String])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (Maybe [String])
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
          Just Maybe [String]
Nothing -> POpts
-> Val (Maybe [String])
-> String
-> [Tree PE]
-> TT (Maybe [String])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe [String] -> Val (Maybe [String])
forall a. a -> Val a
Val Maybe [String]
forall a. Maybe a
Nothing) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist") [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
          Just (Just [String]
b) -> POpts
-> Val (Maybe [String])
-> String
-> [Tree PE]
-> TT (Maybe [String])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe [String] -> Val (Maybe [String])
forall a. a -> Val a
Val ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
b)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" len=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [String]
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Just " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [String] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [String]
b) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]

-- | read an environment variable: similar to 'System.Environment.getEnv'

--

-- >>> pz @(ReadEnv "PATH" >> Just' >> Not Null) ()

-- Val True

--

-- >>> pl @(ReadEnv "xyzzy") ()

-- Present Nothing (ReadEnv[xyzzy] does not exist)

-- Val Nothing

--

data ReadEnv p deriving Int -> ReadEnv p -> ShowS
[ReadEnv p] -> ShowS
ReadEnv p -> String
(Int -> ReadEnv p -> ShowS)
-> (ReadEnv p -> String)
-> ([ReadEnv p] -> ShowS)
-> Show (ReadEnv p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ReadEnv p -> ShowS
forall k (p :: k). [ReadEnv p] -> ShowS
forall k (p :: k). ReadEnv p -> String
showList :: [ReadEnv p] -> ShowS
$cshowList :: forall k (p :: k). [ReadEnv p] -> ShowS
show :: ReadEnv p -> String
$cshow :: forall k (p :: k). ReadEnv p -> String
showsPrec :: Int -> ReadEnv p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ReadEnv p -> ShowS
Show

instance ( PP p x ~ String
         , P p x
         ) => P (ReadEnv p) x where
  type PP (ReadEnv p) x = Maybe String
  eval :: proxy (ReadEnv p) -> POpts -> x -> m (TT (PP (ReadEnv p) x))
eval proxy (ReadEnv p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ReadEnv"
    TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (Maybe String)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT (Maybe String)
e -> TT (Maybe String) -> m (TT (Maybe String))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Maybe String)
e
      Right String
p -> do
        let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
        Maybe (Maybe String)
mb <- IO (Maybe String) -> m (Maybe (Maybe String))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Maybe String) -> m (Maybe (Maybe String)))
-> IO (Maybe String) -> m (Maybe (Maybe String))
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv String
p
        TT (Maybe String) -> m (TT (Maybe String))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe String) -> m (TT (Maybe String)))
-> TT (Maybe String) -> m (TT (Maybe String))
forall a b. (a -> b) -> a -> b
$ case Maybe (Maybe String)
mb of
          Maybe (Maybe String)
Nothing -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (Maybe String)
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
          Just Maybe String
Nothing -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe String -> Val (Maybe String)
forall a. a -> Val a
Val Maybe String
forall a. Maybe a
Nothing) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist") [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
          Just (Just String
v) -> POpts
-> Val (Maybe String) -> String -> [Tree PE] -> TT (Maybe String)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe String -> Val (Maybe String)
forall a. a -> Val a
Val (String -> Maybe String
forall a. a -> Maybe a
Just String
v)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
v) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]

-- | read all the environment variables as key value pairs: similar to 'System.Environment.getEnvironment'

data ReadEnvAll deriving Int -> ReadEnvAll -> ShowS
[ReadEnvAll] -> ShowS
ReadEnvAll -> String
(Int -> ReadEnvAll -> ShowS)
-> (ReadEnvAll -> String)
-> ([ReadEnvAll] -> ShowS)
-> Show ReadEnvAll
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReadEnvAll] -> ShowS
$cshowList :: [ReadEnvAll] -> ShowS
show :: ReadEnvAll -> String
$cshow :: ReadEnvAll -> String
showsPrec :: Int -> ReadEnvAll -> ShowS
$cshowsPrec :: Int -> ReadEnvAll -> ShowS
Show

instance P ReadEnvAll a where
  type PP ReadEnvAll a = [(String,String)]
  eval :: proxy ReadEnvAll -> POpts -> a -> m (TT (PP ReadEnvAll a))
eval proxy ReadEnvAll
_ POpts
opts a
_ = do
    let msg0 :: String
msg0 = String
"ReadEnvAll"
    Maybe [(String, String)]
mb <- IO [(String, String)] -> m (Maybe [(String, String)])
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO IO [(String, String)]
getEnvironment
    TT [(String, String)] -> m (TT [(String, String)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(String, String)] -> m (TT [(String, String)]))
-> TT [(String, String)] -> m (TT [(String, String)])
forall a b. (a -> b) -> a -> b
$ case Maybe [(String, String)]
mb of
      Maybe [(String, String)]
Nothing -> POpts
-> Val [(String, String)]
-> String
-> [Tree PE]
-> TT [(String, String)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [(String, String)]
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" []
      Just [(String, String)]
v -> POpts
-> Val [(String, String)]
-> String
-> [Tree PE]
-> TT [(String, String)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(String, String)] -> Val [(String, String)]
forall a. a -> Val a
Val [(String, String)]
v) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" count=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([(String, String)] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [(String, String)]
v)) []

-- | get the current time using 'UTCTime'

data TimeUtc deriving Int -> TimeUtc -> ShowS
[TimeUtc] -> ShowS
TimeUtc -> String
(Int -> TimeUtc -> ShowS)
-> (TimeUtc -> String) -> ([TimeUtc] -> ShowS) -> Show TimeUtc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeUtc] -> ShowS
$cshowList :: [TimeUtc] -> ShowS
show :: TimeUtc -> String
$cshow :: TimeUtc -> String
showsPrec :: Int -> TimeUtc -> ShowS
$cshowsPrec :: Int -> TimeUtc -> ShowS
Show

instance P TimeUtc a where
  type PP TimeUtc a = UTCTime
  eval :: proxy TimeUtc -> POpts -> a -> m (TT (PP TimeUtc a))
eval proxy TimeUtc
_ POpts
opts a
_ = do
    let msg0 :: String
msg0 = String
"TimeUtc"
    Maybe UTCTime
mb <- IO UTCTime -> m (Maybe UTCTime)
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO IO UTCTime
getCurrentTime
    TT UTCTime -> m (TT UTCTime)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT UTCTime -> m (TT UTCTime)) -> TT UTCTime -> m (TT UTCTime)
forall a b. (a -> b) -> a -> b
$ case Maybe UTCTime
mb of
      Maybe UTCTime
Nothing -> POpts -> Val UTCTime -> String -> [Tree PE] -> TT UTCTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val UTCTime
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" []
      Just UTCTime
v -> POpts -> Val UTCTime -> String -> [Tree PE] -> TT UTCTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (UTCTime -> Val UTCTime
forall a. a -> Val a
Val UTCTime
v) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> UTCTime -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts UTCTime
v) []

-- | get the current time using 'ZonedTime'

data TimeZt deriving Int -> TimeZt -> ShowS
[TimeZt] -> ShowS
TimeZt -> String
(Int -> TimeZt -> ShowS)
-> (TimeZt -> String) -> ([TimeZt] -> ShowS) -> Show TimeZt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeZt] -> ShowS
$cshowList :: [TimeZt] -> ShowS
show :: TimeZt -> String
$cshow :: TimeZt -> String
showsPrec :: Int -> TimeZt -> ShowS
$cshowsPrec :: Int -> TimeZt -> ShowS
Show

instance P TimeZt a where
  type PP TimeZt a = ZonedTime
  eval :: proxy TimeZt -> POpts -> a -> m (TT (PP TimeZt a))
eval proxy TimeZt
_ POpts
opts a
_ = do
    let msg0 :: String
msg0 = String
"TimeZt"
    Maybe ZonedTime
mb <- IO ZonedTime -> m (Maybe ZonedTime)
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO IO ZonedTime
getZonedTime
    TT ZonedTime -> m (TT ZonedTime)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT ZonedTime -> m (TT ZonedTime))
-> TT ZonedTime -> m (TT ZonedTime)
forall a b. (a -> b) -> a -> b
$ case Maybe ZonedTime
mb of
      Maybe ZonedTime
Nothing -> POpts -> Val ZonedTime -> String -> [Tree PE] -> TT ZonedTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ZonedTime
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" []
      Just ZonedTime
v -> POpts -> Val ZonedTime -> String -> [Tree PE] -> TT ZonedTime
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ZonedTime -> Val ZonedTime
forall a. a -> Val a
Val ZonedTime
v) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ZonedTime -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts ZonedTime
v) []

data FHandle s = FStdout | FStderr | FOther !s !WFMode
  deriving stock (ReadPrec [FHandle s]
ReadPrec (FHandle s)
Int -> ReadS (FHandle s)
ReadS [FHandle s]
(Int -> ReadS (FHandle s))
-> ReadS [FHandle s]
-> ReadPrec (FHandle s)
-> ReadPrec [FHandle s]
-> Read (FHandle s)
forall s. Read s => ReadPrec [FHandle s]
forall s. Read s => ReadPrec (FHandle s)
forall s. Read s => Int -> ReadS (FHandle s)
forall s. Read s => ReadS [FHandle s]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FHandle s]
$creadListPrec :: forall s. Read s => ReadPrec [FHandle s]
readPrec :: ReadPrec (FHandle s)
$creadPrec :: forall s. Read s => ReadPrec (FHandle s)
readList :: ReadS [FHandle s]
$creadList :: forall s. Read s => ReadS [FHandle s]
readsPrec :: Int -> ReadS (FHandle s)
$creadsPrec :: forall s. Read s => Int -> ReadS (FHandle s)
Read, Int -> FHandle s -> ShowS
[FHandle s] -> ShowS
FHandle s -> String
(Int -> FHandle s -> ShowS)
-> (FHandle s -> String)
-> ([FHandle s] -> ShowS)
-> Show (FHandle s)
forall s. Show s => Int -> FHandle s -> ShowS
forall s. Show s => [FHandle s] -> ShowS
forall s. Show s => FHandle s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FHandle s] -> ShowS
$cshowList :: forall s. Show s => [FHandle s] -> ShowS
show :: FHandle s -> String
$cshow :: forall s. Show s => FHandle s -> String
showsPrec :: Int -> FHandle s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> FHandle s -> ShowS
Show, FHandle s -> FHandle s -> Bool
(FHandle s -> FHandle s -> Bool)
-> (FHandle s -> FHandle s -> Bool) -> Eq (FHandle s)
forall s. Eq s => FHandle s -> FHandle s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FHandle s -> FHandle s -> Bool
$c/= :: forall s. Eq s => FHandle s -> FHandle s -> Bool
== :: FHandle s -> FHandle s -> Bool
$c== :: forall s. Eq s => FHandle s -> FHandle s -> Bool
Eq)

class GetFHandle (x :: FHandle Symbol) where getFHandle :: FHandle String
instance GetFHandle 'FStdout where getFHandle :: FHandle String
getFHandle = FHandle String
forall s. FHandle s
FStdout
instance GetFHandle 'FStderr where getFHandle :: FHandle String
getFHandle = FHandle String
forall s. FHandle s
FStderr
instance ( GetMode w
         , KnownSymbol s
         ) => GetFHandle ('FOther s w) where getFHandle :: FHandle String
getFHandle = String -> WFMode -> FHandle String
forall s. s -> WFMode -> FHandle s
FOther (KnownSymbol s => String
forall (s :: Symbol). KnownSymbol s => String
symb @s) (GetMode w => WFMode
forall (x :: WFMode). GetMode x => WFMode
getMode @w)

data WFMode = WFAppend | WFWrite | WFWriteForce
  deriving stock (ReadPrec [WFMode]
ReadPrec WFMode
Int -> ReadS WFMode
ReadS [WFMode]
(Int -> ReadS WFMode)
-> ReadS [WFMode]
-> ReadPrec WFMode
-> ReadPrec [WFMode]
-> Read WFMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WFMode]
$creadListPrec :: ReadPrec [WFMode]
readPrec :: ReadPrec WFMode
$creadPrec :: ReadPrec WFMode
readList :: ReadS [WFMode]
$creadList :: ReadS [WFMode]
readsPrec :: Int -> ReadS WFMode
$creadsPrec :: Int -> ReadS WFMode
Read, Int -> WFMode -> ShowS
[WFMode] -> ShowS
WFMode -> String
(Int -> WFMode -> ShowS)
-> (WFMode -> String) -> ([WFMode] -> ShowS) -> Show WFMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WFMode] -> ShowS
$cshowList :: [WFMode] -> ShowS
show :: WFMode -> String
$cshow :: WFMode -> String
showsPrec :: Int -> WFMode -> ShowS
$cshowsPrec :: Int -> WFMode -> ShowS
Show, WFMode -> WFMode -> Bool
(WFMode -> WFMode -> Bool)
-> (WFMode -> WFMode -> Bool) -> Eq WFMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WFMode -> WFMode -> Bool
$c/= :: WFMode -> WFMode -> Bool
== :: WFMode -> WFMode -> Bool
$c== :: WFMode -> WFMode -> Bool
Eq)

class GetMode (x :: WFMode) where getMode :: WFMode
instance GetMode 'WFAppend where getMode :: WFMode
getMode = WFMode
WFAppend
instance GetMode 'WFWriteForce where getMode :: WFMode
getMode = WFMode
WFWriteForce
instance GetMode 'WFWrite where getMode :: WFMode
getMode = WFMode
WFWrite

data WriteFileImpl (hh :: FHandle Symbol) p deriving Int -> WriteFileImpl hh p -> ShowS
[WriteFileImpl hh p] -> ShowS
WriteFileImpl hh p -> String
(Int -> WriteFileImpl hh p -> ShowS)
-> (WriteFileImpl hh p -> String)
-> ([WriteFileImpl hh p] -> ShowS)
-> Show (WriteFileImpl hh p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (hh :: FHandle Symbol) k (p :: k).
Int -> WriteFileImpl hh p -> ShowS
forall (hh :: FHandle Symbol) k (p :: k).
[WriteFileImpl hh p] -> ShowS
forall (hh :: FHandle Symbol) k (p :: k).
WriteFileImpl hh p -> String
showList :: [WriteFileImpl hh p] -> ShowS
$cshowList :: forall (hh :: FHandle Symbol) k (p :: k).
[WriteFileImpl hh p] -> ShowS
show :: WriteFileImpl hh p -> String
$cshow :: forall (hh :: FHandle Symbol) k (p :: k).
WriteFileImpl hh p -> String
showsPrec :: Int -> WriteFileImpl hh p -> ShowS
$cshowsPrec :: forall (hh :: FHandle Symbol) k (p :: k).
Int -> WriteFileImpl hh p -> ShowS
Show

-- | append to a file

data AppendFile (s :: Symbol) p deriving Int -> AppendFile s p -> ShowS
[AppendFile s p] -> ShowS
AppendFile s p -> String
(Int -> AppendFile s p -> ShowS)
-> (AppendFile s p -> String)
-> ([AppendFile s p] -> ShowS)
-> Show (AppendFile s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) k (p :: k). Int -> AppendFile s p -> ShowS
forall (s :: Symbol) k (p :: k). [AppendFile s p] -> ShowS
forall (s :: Symbol) k (p :: k). AppendFile s p -> String
showList :: [AppendFile s p] -> ShowS
$cshowList :: forall (s :: Symbol) k (p :: k). [AppendFile s p] -> ShowS
show :: AppendFile s p -> String
$cshow :: forall (s :: Symbol) k (p :: k). AppendFile s p -> String
showsPrec :: Int -> AppendFile s p -> ShowS
$cshowsPrec :: forall (s :: Symbol) k (p :: k). Int -> AppendFile s p -> ShowS
Show
type AppendFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFAppend) p

instance P (AppendFileT s p) x => P (AppendFile s p) x where
  type PP (AppendFile s p) x = PP (AppendFileT s p) x
  eval :: proxy (AppendFile s p)
-> POpts -> x -> m (TT (PP (AppendFile s p) x))
eval proxy (AppendFile s p)
_ = Proxy (AppendFileT s p)
-> POpts -> x -> m (TT (PP (AppendFileT s p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (AppendFileT s p)
forall k (t :: k). Proxy t
Proxy @(AppendFileT s p))


-- | write to file, overwriting if needed

data WriteFile' (s :: Symbol) p deriving Int -> WriteFile' s p -> ShowS
[WriteFile' s p] -> ShowS
WriteFile' s p -> String
(Int -> WriteFile' s p -> ShowS)
-> (WriteFile' s p -> String)
-> ([WriteFile' s p] -> ShowS)
-> Show (WriteFile' s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) k (p :: k). Int -> WriteFile' s p -> ShowS
forall (s :: Symbol) k (p :: k). [WriteFile' s p] -> ShowS
forall (s :: Symbol) k (p :: k). WriteFile' s p -> String
showList :: [WriteFile' s p] -> ShowS
$cshowList :: forall (s :: Symbol) k (p :: k). [WriteFile' s p] -> ShowS
show :: WriteFile' s p -> String
$cshow :: forall (s :: Symbol) k (p :: k). WriteFile' s p -> String
showsPrec :: Int -> WriteFile' s p -> ShowS
$cshowsPrec :: forall (s :: Symbol) k (p :: k). Int -> WriteFile' s p -> ShowS
Show
type WriteFileT' (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWriteForce) p

instance P (WriteFileT' s p) x => P (WriteFile' s p) x where
  type PP (WriteFile' s p) x = PP (WriteFileT' s p) x
  eval :: proxy (WriteFile' s p)
-> POpts -> x -> m (TT (PP (WriteFile' s p) x))
eval proxy (WriteFile' s p)
_ = Proxy (WriteFileT' s p)
-> POpts -> x -> m (TT (PP (WriteFileT' s p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (WriteFileT' s p)
forall k (t :: k). Proxy t
Proxy @(WriteFileT' s p))

-- | write to file, without overwriting

data WriteFile (s :: Symbol) p deriving Int -> WriteFile s p -> ShowS
[WriteFile s p] -> ShowS
WriteFile s p -> String
(Int -> WriteFile s p -> ShowS)
-> (WriteFile s p -> String)
-> ([WriteFile s p] -> ShowS)
-> Show (WriteFile s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) k (p :: k). Int -> WriteFile s p -> ShowS
forall (s :: Symbol) k (p :: k). [WriteFile s p] -> ShowS
forall (s :: Symbol) k (p :: k). WriteFile s p -> String
showList :: [WriteFile s p] -> ShowS
$cshowList :: forall (s :: Symbol) k (p :: k). [WriteFile s p] -> ShowS
show :: WriteFile s p -> String
$cshow :: forall (s :: Symbol) k (p :: k). WriteFile s p -> String
showsPrec :: Int -> WriteFile s p -> ShowS
$cshowsPrec :: forall (s :: Symbol) k (p :: k). Int -> WriteFile s p -> ShowS
Show
type WriteFileT (s :: Symbol) p = WriteFileImpl ('FOther s 'WFWrite) p

instance P (WriteFileT s p) x => P (WriteFile s p) x where
  type PP (WriteFile s p) x = PP (WriteFileT s p) x
  eval :: proxy (WriteFile s p)
-> POpts -> x -> m (TT (PP (WriteFile s p) x))
eval proxy (WriteFile s p)
_ = Proxy (WriteFileT s p)
-> POpts -> x -> m (TT (PP (WriteFileT s p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (WriteFileT s p)
forall k (t :: k). Proxy t
Proxy @(WriteFileT s p))

-- | write a string value to stdout

data Stdout p deriving Int -> Stdout p -> ShowS
[Stdout p] -> ShowS
Stdout p -> String
(Int -> Stdout p -> ShowS)
-> (Stdout p -> String) -> ([Stdout p] -> ShowS) -> Show (Stdout p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Stdout p -> ShowS
forall k (p :: k). [Stdout p] -> ShowS
forall k (p :: k). Stdout p -> String
showList :: [Stdout p] -> ShowS
$cshowList :: forall k (p :: k). [Stdout p] -> ShowS
show :: Stdout p -> String
$cshow :: forall k (p :: k). Stdout p -> String
showsPrec :: Int -> Stdout p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Stdout p -> ShowS
Show
type StdoutT p = WriteFileImpl 'FStdout p

instance P (StdoutT p) x => P (Stdout p) x where
  type PP (Stdout p) x = PP (StdoutT p) x
  eval :: proxy (Stdout p) -> POpts -> x -> m (TT (PP (Stdout p) x))
eval proxy (Stdout p)
_ = Proxy (StdoutT p) -> POpts -> x -> m (TT (PP (StdoutT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (StdoutT p)
forall k (t :: k). Proxy t
Proxy @(StdoutT p))

-- | write a string value to stderr

data Stderr p deriving Int -> Stderr p -> ShowS
[Stderr p] -> ShowS
Stderr p -> String
(Int -> Stderr p -> ShowS)
-> (Stderr p -> String) -> ([Stderr p] -> ShowS) -> Show (Stderr p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Stderr p -> ShowS
forall k (p :: k). [Stderr p] -> ShowS
forall k (p :: k). Stderr p -> String
showList :: [Stderr p] -> ShowS
$cshowList :: forall k (p :: k). [Stderr p] -> ShowS
show :: Stderr p -> String
$cshow :: forall k (p :: k). Stderr p -> String
showsPrec :: Int -> Stderr p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Stderr p -> ShowS
Show
type StderrT p = WriteFileImpl 'FStderr p

instance P (StderrT p) x => P (Stderr p) x where
  type PP (Stderr p) x = PP (StderrT p) x
  eval :: proxy (Stderr p) -> POpts -> x -> m (TT (PP (Stderr p) x))
eval proxy (Stderr p)
_ = Proxy (StderrT p) -> POpts -> x -> m (TT (PP (StderrT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (StderrT p)
forall k (t :: k). Proxy t
Proxy @(StderrT p))

instance ( GetFHandle fh
         , P p a
         , PP p a ~ String
         ) => P (WriteFileImpl fh p) a where
  type PP (WriteFileImpl fh p) a = ()
  eval :: proxy (WriteFileImpl fh p)
-> POpts -> a -> m (TT (PP (WriteFileImpl fh p) a))
eval proxy (WriteFileImpl fh p)
_ POpts
opts a
a = do
    let fh :: FHandle String
fh = GetFHandle fh => FHandle String
forall (x :: FHandle Symbol). GetFHandle x => FHandle String
getFHandle @fh
        msg0 :: String
msg0 = case FHandle String
fh of
                      FHandle String
FStdout -> String
"Stdout"
                      FHandle String
FStderr -> String
"Stderr"
                      FOther String
s WFMode
w -> (String -> ShowS
forall a. Semigroup a => a -> a -> a
<>(String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]")) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ case WFMode
w of
                         WFMode
WFAppend -> String
"AppendFile"
                         WFMode
WFWrite -> String
"WriteFile"
                         WFMode
WFWriteForce -> String
"WriteFile'"
    TT String
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
    case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT ()) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT ()
e -> TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT ()
e
      Right String
ss -> do
          Maybe (Either String ())
mb <- IO (Either String ()) -> m (Maybe (Either String ()))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Either String ()) -> m (Maybe (Either String ())))
-> IO (Either String ()) -> m (Maybe (Either String ()))
forall a b. (a -> b) -> a -> b
$ case FHandle String
fh of
                  FHandle String
FStdout -> (SomeException -> String)
-> Either SomeException () -> Either String ()
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left SomeException -> String
forall e. Exception e => e -> String
E.displayException (Either SomeException () -> Either String ())
-> IO (Either SomeException ()) -> IO (Either String ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException (String -> IO ()
putStr String
ss)
                  FHandle String
FStderr -> (SomeException -> String)
-> Either SomeException () -> Either String ()
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left SomeException -> String
forall e. Exception e => e -> String
E.displayException (Either SomeException () -> Either String ())
-> IO (Either SomeException ()) -> IO (Either String ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException (Handle -> String -> IO ()
hPutStr Handle
stderr String
ss)
                  FOther String
s WFMode
w -> do
                     Bool
b <- String -> IO Bool
doesFileExist String
s
                     if Bool
b Bool -> Bool -> Bool
&& WFMode
w WFMode -> WFMode -> Bool
forall a. Eq a => a -> a -> Bool
== WFMode
WFWrite then Either String () -> IO (Either String ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"file [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"] already exists"
                     else do
                            let md :: IOMode
md = case WFMode
w of
                                       WFMode
WFAppend -> IOMode
AppendMode
                                       WFMode
WFWrite -> IOMode
WriteMode
                                       WFMode
WFWriteForce -> IOMode
WriteMode
                            (SomeException -> String)
-> Either SomeException () -> Either String ()
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left SomeException -> String
forall e. Exception e => e -> String
E.displayException (Either SomeException () -> Either String ())
-> IO (Either SomeException ()) -> IO (Either String ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException (String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
s IOMode
md (Handle -> String -> IO ()
`hPutStr` String
ss))
          TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT () -> m (TT ())) -> TT () -> m (TT ())
forall a b. (a -> b) -> a -> b
$ case Maybe (Either String ())
mb of
            Maybe (Either String ())
Nothing -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ()
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
            Just (Left String
e) -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ()
forall a. String -> Val a
Fail (String -> Val ()) -> String -> Val ()
forall a b. (a -> b) -> a -> b
$ String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e) String
"" [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
            Just (Right ()) -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (() -> Val ()
forall a. a -> Val a
Val ()) String
msg0 [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]

-- | read in a value of a given type from stdin with a prompt: similar to 'System.IO.readIO'

type ReadIO (t :: Type) = ReadIO' t "Enter value"
-- | similar to 'ReadIO' but allow the user to specify the prompt string @s@

type ReadIO' (t :: Type) s = Stdout (s <> ":") >> Stdin >> ReadP t Id
-- eg pa @(ReadIO Int + ReadIO Int) ()


-- | read a value from stdin

data Stdin deriving Int -> Stdin -> ShowS
[Stdin] -> ShowS
Stdin -> String
(Int -> Stdin -> ShowS)
-> (Stdin -> String) -> ([Stdin] -> ShowS) -> Show Stdin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stdin] -> ShowS
$cshowList :: [Stdin] -> ShowS
show :: Stdin -> String
$cshow :: Stdin -> String
showsPrec :: Int -> Stdin -> ShowS
$cshowsPrec :: Int -> Stdin -> ShowS
Show

instance P Stdin x where
  type PP Stdin x = String
  eval :: proxy Stdin -> POpts -> x -> m (TT (PP Stdin x))
eval proxy Stdin
_ POpts
opts x
_ = do
    let msg0 :: String
msg0 = String
"Stdin"
    Maybe (Either SomeException String)
mb <- IO (Either SomeException String)
-> m (Maybe (Either SomeException String))
forall (m :: Type -> Type) a. MonadEval m => IO a -> m (Maybe a)
runIO (IO (Either SomeException String)
 -> m (Maybe (Either SomeException String)))
-> IO (Either SomeException String)
-> m (Maybe (Either SomeException String))
forall a b. (a -> b) -> a -> b
$ IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
E.try @E.SomeException IO String
getLine
    TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ case Maybe (Either SomeException String)
mb of
      Maybe (Either SomeException String)
Nothing -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" must run in IO")) String
"" []
      Just (Left SomeException
e) -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. String -> Val a
Fail (String -> Val String) -> String -> Val String
forall a b. (a -> b) -> a -> b
$ String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall e. Exception e => e -> String
E.displayException SomeException
e) String
"" []
      Just (Right String
ss) -> POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val String
ss) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
"" String
ss String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") []