{-|
Module      : Options.OptStream.Internal
Copyright   : (c) Dan Shved, 2022
License     : BSD-3
Maintainer  : danshved@gmail.com
Stability   : experimental

Internal helpers for the optstream library. Should not be imported directly
from the outside.
-}
module Options.OptStream.Internal where

import Data.Foldable
import Data.Function
import Data.List
import Data.Maybe
import Prelude hiding (putStrLn)

import Options.OptStream.IOOps


-- * Quickly composable lists

newtype List a = List ([a] -> [a])

single :: a -> List a
single :: a -> List a
single a
a = ([a] -> [a]) -> List a
forall a. ([a] -> [a]) -> List a
List (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

fromList :: [a] -> List a
fromList :: [a] -> List a
fromList [a]
as = ([a] -> [a]) -> List a
forall a. ([a] -> [a]) -> List a
List ([a]
as[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++)

instance Semigroup (List a) where
  List [a] -> [a]
f <> :: List a -> List a -> List a
<> List [a] -> [a]
g = ([a] -> [a]) -> List a
forall a. ([a] -> [a]) -> List a
List (([a] -> [a]) -> List a) -> ([a] -> [a]) -> List a
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
f ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
g

instance Monoid (List a) where
  mempty :: List a
mempty = ([a] -> [a]) -> List a
forall a. ([a] -> [a]) -> List a
List [a] -> [a]
forall a. a -> a
id

instance Foldable List where
  foldr :: (a -> b -> b) -> b -> List a -> b
foldr a -> b -> b
comb b
acc (List [a] -> [a]
f) = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
comb b
acc ([a] -> b) -> [a] -> b
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
f []
  toList :: List a -> [a]
toList (List [a] -> [a]
f) = [a] -> [a]
f []

instance Show a => Show (List a) where
  showsPrec :: Int -> List a -> ShowS
showsPrec Int
d List a
l = Bool -> ShowS -> ShowS
showParen (Int
10 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
d) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList List a
l)

instance Eq a => Eq (List a) where
  == :: List a -> List a -> Bool
(==) = [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([a] -> [a] -> Bool) -> (List a -> [a]) -> List a -> List a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` List a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList


-- * Removing duplicates

nubOrd :: Ord a => [a] -> [a]
nubOrd :: [a] -> [a]
nubOrd = [a] -> [a]
forall a. Eq a => [a] -> [a]
work ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. Ord a => [a] -> [a]
sort where
  work :: [a] -> [a]
work (a
x:xs :: [a]
xs@(a
y:[a]
ys))
    | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = [a] -> [a]
work ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys
    | Bool
otherwise = a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a] -> [a]
work [a]
xs
  work [a]
xs = [a]
xs


-- * Option forms

-- | High-level option parsers all accept a list of /option forms/. An option
-- form is simply a 'String'.
--
-- There are two kinds of legal option forms: /short forms/, e.g. @"-f"@, and
-- /long forms/, e.g. @"--foo"@. Any function that accepts an 'OptionForm' will
-- fail with an 'error' if the option form is illegal. See 'isLegalOptionForm'.
type OptionForm = String

data Option = Short Char | Long String
  deriving Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> String
$cshow :: Option -> String
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Show

parseOptionForm_ :: OptionForm -> Maybe Option
parseOptionForm_ :: String -> Maybe Option
parseOptionForm_ (Char
'-':Char
c:[]) | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-' = Option -> Maybe Option
forall a. a -> Maybe a
Just (Option -> Maybe Option) -> Option -> Maybe Option
forall a b. (a -> b) -> a -> b
$ Char -> Option
Short Char
c
parseOptionForm_ (Char
'-':Char
'-':s :: String
s@(Char
_:String
_)) = Option -> Maybe Option
forall a. a -> Maybe a
Just (Option -> Maybe Option) -> Option -> Maybe Option
forall a b. (a -> b) -> a -> b
$ String -> Option
Long String
s
parseOptionForm_ String
_ = Maybe Option
forall a. Maybe a
Nothing

-- | Checks whether the given string is a legal option form. A legal short form
-- is @-C@, where @C@ is any character other than @-@. A legal long form is
-- @--STR@, where @STR@ is any non-empty string.
--
-- This function is here just in case. Normally the programmer will provide
-- option forms as string literals, so they will probably be legal.
--
-- ==== __Example:__
-- >>> isLegalOptionForm "-f"
-- True
-- >>> isLegalOptionForm "--foo"
-- True
-- >>> isLegalOptionForm "bar"
-- False
-- >>> isLegalOptionForm ""
-- False
-- >>> isLegalOptionForm "-"
-- False
-- >>> isLegalOptionForm "--"
-- False
-- >>> isLegalOptionForm "---"
-- True
isLegalOptionForm :: OptionForm -> Bool
isLegalOptionForm :: String -> Bool
isLegalOptionForm = Maybe Option -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Option -> Bool)
-> (String -> Maybe Option) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Option
parseOptionForm_

parseOptionForm :: OptionForm -> Option
parseOptionForm :: String -> Option
parseOptionForm String
s = case String -> Maybe Option
parseOptionForm_ String
s of
  Just Option
x -> Option
x
  Maybe Option
Nothing -> String -> Option
forall a. HasCallStack => String -> a
error (String -> Option) -> String -> Option
forall a b. (a -> b) -> a -> b
$ String
"illegal option form " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s


-- * Miscellaneous

versionToIO :: IOOps m => Either String a -> m a
versionToIO :: Either String a -> m a
versionToIO (Right a
a) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
versionToIO (Left String
s) = do
  String -> m ()
forall (m :: * -> *). IOOps m => String -> m ()
putStrLn String
s
  m a
forall (m :: * -> *) a. IOOps m => m a
exitSuccess