{-# LANGUAGE PatternGuards #-}

module System.Console.CmdArgs.Implicit.Reader(Reader(..), reader) where

import Data.Generics.Any
import qualified Data.Generics.Any.Prelude as A
import System.Console.CmdArgs.Explicit
import Data.Char
import Data.Int
import Data.Word
import Data.List
import Data.Maybe


data Reader = Reader
    {Reader -> String
readerHelp :: String
    ,Reader -> Bool
readerBool :: Bool
    ,Reader -> Int
readerParts :: Int
    ,Reader -> Any -> Any
readerFixup :: Any -> Any -- If a list, then 'reverse', otherwise nothing, so we can build up using cons in O(n)
    ,Reader -> Any -> String -> Either String Any
readerRead :: Any -> String -> Either String Any
    }

-- reader has an actual value of type Any that can be inspected
-- reader_ has a value of type _|_ instead
readerRead_ :: Reader -> String -> Either String Any
readerRead_ Reader
r = Reader -> Any -> String -> Either String Any
readerRead Reader
r forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"Invariant broken: reader/reader_"


reader :: Any -> Maybe Reader
reader :: Any -> Maybe Reader
reader Any
x | Any -> Bool
A.isList Any
x Bool -> Bool -> Bool
&& Bool -> Bool
not (Any -> Bool
A.isString Any
x) = do
    Reader
r <- Any -> Maybe Reader
reader_ forall a b. (a -> b) -> a -> b
$ Any -> Any
A.fromList Any
x
    forall (m :: * -> *) a. Monad m => a -> m a
return Reader
r{readerRead :: Any -> String -> Either String Any
readerRead = \Any
o String
s -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Any -> Any -> Any
`A.cons` Any
o) forall a b. (a -> b) -> a -> b
$ Reader -> String -> Either String Any
readerRead_ Reader
r String
s, readerFixup :: Any -> Any
readerFixup = forall a. Any -> Any
A.reverse}
reader Any
x | Any -> Bool
isAlgType Any
x, [String
ctor] <- Any -> [String]
ctors Any
x, [Any
child] <- Any -> [Any]
children Any
x = do
    -- newtype wrapper, just forward it
    Reader
r <- Any -> Maybe Reader
reader Any
child
    let down :: Any -> Any
down = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> [Any]
children
    let up :: Any -> Any -> Any
up Any
o Any
c = Any -> [Any] -> Any
recompose Any
o [Any
c]
    forall (m :: * -> *) a. Monad m => a -> m a
return Reader
r{readerFixup :: Any -> Any
readerFixup = \Any
x -> Any -> Any -> Any
up Any
x forall a b. (a -> b) -> a -> b
$ Reader -> Any -> Any
readerFixup Reader
r forall a b. (a -> b) -> a -> b
$ Any -> Any
down Any
x
            ,readerRead :: Any -> String -> Either String Any
readerRead = \Any
x -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> Any -> Any
up Any
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader -> Any -> String -> Either String Any
readerRead Reader
r (Any -> Any
down Any
x)
            }
reader Any
x = Any -> Maybe Reader
reader_ Any
x


reader_ :: Any -> Maybe Reader
reader_ :: Any -> Maybe Reader
reader_ Any
x | Any -> Bool
A.isString Any
x = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
-> Bool
-> Int
-> (Any -> Any)
-> (Any -> String -> Either String Any)
-> Reader
Reader String
"ITEM" Bool
False Int
1 forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> Any
Any


reader_ Any
x | Any -> String
typeName Any
x forall a. Eq a => a -> a -> Bool
== String
"Bool" = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
-> Bool
-> Int
-> (Any -> Any)
-> (Any -> String -> Either String Any)
-> Reader
Reader String
"BOOL" Bool
True Int
1 forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ \String
s ->
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Could not read as boolean, " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Data a => a -> Any
Any) forall a b. (a -> b) -> a -> b
$ String -> Maybe Bool
parseBool String
s


reader_ Any
x | Reader
res:[Reader]
_ <- forall a. [Maybe a] -> [a]
catMaybes
    [forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"INT" (Integer
0::Integer), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"NUM" (Float
0::Float), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"NUM" (Double
0::Double)
    ,forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"INT" (Int
0::Int), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"INT" (Int8
0::Int8), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"INT" (Int16
0::Int16), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"INT" (Int32
0::Int32), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"INT" (Int64
0::Int64)
    ,forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"NAT" (Word
0::Word), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"NAT" (Word8
0::Word8), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"NAT" (Word16
0::Word16), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"NAT" (Word32
0::Word32), forall {a}. (Data a, Read a) => String -> a -> Maybe Reader
f String
"NAT" (Word64
0::Word64)
    ] = forall a. a -> Maybe a
Just Reader
res
    where
        ty :: TypeRep
ty = Any -> TypeRep
typeOf Any
x
        f :: String -> a -> Maybe Reader
f String
hlp a
t | Any -> TypeRep
typeOf (forall a. Data a => a -> Any
Any a
t) forall a. Eq a => a -> a -> Bool
/= TypeRep
ty = forall a. Maybe a
Nothing
                | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
-> Bool
-> Int
-> (Any -> Any)
-> (Any -> String -> Either String Any)
-> Reader
Reader String
hlp Bool
False Int
1 forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ \String
s -> case forall a. Read a => ReadS a
reads String
s of
            [(a
x,String
"")] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. Data a => a -> Any
Any forall a b. (a -> b) -> a -> b
$ a
x forall a. a -> a -> a
`asTypeOf` a
t
            [(a, String)]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Could not read as type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Any -> TypeRep
typeOf forall a b. (a -> b) -> a -> b
$ forall a. Data a => a -> Any
Any a
t) forall a. [a] -> [a] -> [a]
++ String
", " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s


reader_ Any
x | Any -> Bool
A.isList Any
x = do
    Reader
r <- Any -> Maybe Reader
reader_ forall a b. (a -> b) -> a -> b
$ Any -> Any
A.fromList Any
x
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Reader
r{readerRead :: Any -> String -> Either String Any
readerRead = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Any -> Any -> Any
A.list_ Any
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader -> String -> Either String Any
readerRead_ Reader
r}


reader_ Any
x | Any -> Bool
A.isMaybe Any
x = do
    Reader
r <- Any -> Maybe Reader
reader_ forall a b. (a -> b) -> a -> b
$ Any -> Any
A.fromMaybe Any
x
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Reader
r{readerRead :: Any -> String -> Either String Any
readerRead = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Any -> Any -> Any
A.just_ Any
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader -> String -> Either String Any
readerRead_ Reader
r}


reader_ Any
x | Any -> Bool
isAlgType Any
x Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Any)]
xs forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
(==) Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any -> Int
arity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(String, Any)]
xs
    = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
-> Bool
-> Int
-> (Any -> Any)
-> (Any -> String -> Either String Any)
-> Reader
Reader (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall a b. (a -> b) -> a -> b
$ Any -> String
typeShell Any
x) (Any -> String
typeName Any
x forall a. Eq a => a -> a -> Bool
== String
"Bool") Int
1 forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ String -> Either String Any
rd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
    where
        xs :: [(String, Any)]
xs = [(forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c, Any -> String -> Any
compose0 Any
x String
c) | String
c <- Any -> [String]
ctors Any
x]

        rd :: String -> Either String Any
rd String
s | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Any)]
ys = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Could not read " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
", expected one of: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Any)]
xs)
             | Just (String
_,Any
x) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
(==) String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, Any)]
ys = forall a b. b -> Either a b
Right Any
x
             | forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Any)]
ys forall a. Ord a => a -> a -> Bool
> Int
1 = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Ambiguous read for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
", could be any of: " forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Any)]
ys)
             | Bool
otherwise = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(String, Any)]
ys
            where ys :: [(String, Any)]
ys = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, Any)]
xs


reader_ Any
x | Any -> Bool
isAlgType Any
x, [String
c] <- Any -> [String]
ctors Any
x, Any
x <- Any -> String -> Any
compose0 Any
x String
c = do
    let cs :: [Any]
cs = Any -> [Any]
children Any
x
    [Reader]
rs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Any -> Maybe Reader
reader_ [Any]
cs
    let n :: Int
n = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Reader -> Int
readerParts [Reader]
rs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
-> Bool
-> Int
-> (Any -> Any)
-> (Any -> String -> Either String Any)
-> Reader
Reader ([String] -> String
uncommas forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Reader -> String
readerHelp [Reader]
rs) (forall a b. (a -> b) -> [a] -> [b]
map Reader -> Bool
readerBool [Reader]
rs forall a. Eq a => a -> a -> Bool
== [Bool
True]) Int
n forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ \String
s ->
        let ss :: [String]
ss = String -> [String]
commas String
s in
        if Int
n forall a. Eq a => a -> a -> Bool
== Int
1 then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Any -> [Any] -> Any
recompose Any
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) forall a b. (a -> b) -> a -> b
$ Reader -> String -> Either String Any
readerRead_ (forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader -> Int
readerParts) [Reader]
rs) String
s
        else if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ss forall a. Eq a => a -> a -> Bool
/= Int
n then forall a b. a -> Either a b
Left String
"Incorrect number of commas for fields"
        else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Any -> [Any] -> Any
recompose Any
x) forall a b. (a -> b) -> a -> b
$ forall {a} {a}. [Either a a] -> Either a [a]
sequenceEither forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Reader -> String -> Either String Any
readerRead_ [Reader]
rs forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
uncommas forall a b. (a -> b) -> a -> b
$ forall {a}. [Int] -> [a] -> [[a]]
takes (forall a b. (a -> b) -> [a] -> [b]
map Reader -> Int
readerParts [Reader]
rs) [String]
ss


reader_ Any
_ = forall a. Maybe a
Nothing


uncommas :: [String] -> String
uncommas = forall a. [a] -> [[a]] -> [a]
intercalate String
","
commas :: String -> [String]
commas = String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x forall a. Eq a => a -> a -> Bool
== Char
',' then Char
'\n' else Char
x)


takes :: [Int] -> [a] -> [[a]]
takes [] [a]
_ = []
takes (Int
i:[Int]
is) [a]
xs = [a]
a forall a. a -> [a] -> [a]
: [Int] -> [a] -> [[a]]
takes [Int]
is [a]
b
    where ([a]
a,[a]
b) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
xs

sequenceEither :: [Either a a] -> Either a [a]
sequenceEither = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}. Either a a -> Either a [a] -> Either a [a]
f (forall a b. b -> Either a b
Right [])
    where f :: Either a a -> Either a [a] -> Either a [a]
f (Left a
x) Either a [a]
_ = forall a b. a -> Either a b
Left a
x
          f Either a a
_ (Left a
x) = forall a b. a -> Either a b
Left a
x
          f (Right a
x) (Right [a]
xs) = forall a b. b -> Either a b
Right (a
xforall a. a -> [a] -> [a]
:[a]
xs)