content: {-# 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
      {readerHelp :: String
      ,readerBool :: Bool
      ,readerParts :: Int
      ,readerFixup :: Any -> Any -- If a list, then 'reverse', otherwise nothing, so we can build up using cons in O(n)
      ,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_ r = readerRead r $ error "Invariant broken: reader/reader_"
  
  
  reader :: Any -> Maybe Reader
  reader x | A.isList x && not (A.isString x) = do
      r <- reader_ $ A.fromList x
      return r{readerRead = \o s -> fmap (`A.cons` o) $ readerRead_ r s, readerFixup = A.reverse}
  reader x | isAlgType x, [ctor] <- ctors x, [child] <- children x = do
      -- newtype wrapper, just forward it
      r <- reader child
      let down = head . children
      let up o c = recompose o [c]
      return r{readerFixup = \x -> up x $ readerFixup r $ down x
              ,readerRead = \x -> either Left (Right . up x) . readerRead r (down x)
              }
  reader x = reader_ x
  
  
  reader_ :: Any -> Maybe Reader
  reader_ x | A.isString x = Just $ Reader "ITEM" False 1 id $ const $ Right . Any
  
  
  reader_ x | typeName x == "Bool" = Just $ Reader "BOOL" True 1 id $ const $ \s ->
      maybe (Left $ "Could not read as boolean, " ++ show s) (Right . Any) $ parseBool s
  
  
  reader_ x | res:_ <- catMaybes
      [f "INT" (0::Integer), f "NUM" (0::Float), f "NUM" (0::Double)
      ,f "INT" (0::Int), f "INT" (0::Int8), f "INT" (0::Int16), f "INT" (0::Int32), f "INT" (0::Int64)
      ,f "NAT" (0::Word), f "NAT" (0::Word8), f "NAT" (0::Word16), f "NAT" (0::Word32), f "NAT" (0::Word64)
      ] = Just res
      where
          ty = typeOf x
          f hlp t | typeOf (Any t) /= ty = Nothing
                  | otherwise = Just $ Reader hlp False 1 id $ const $ \s -> case reads s of
              [(x,"")] -> Right $ Any $ x `asTypeOf` t
              _ -> Left $ "Could not read as type " ++ show (typeOf $ Any t) ++ ", " ++ show s
  
  
  reader_ x | A.isList x = do
      r <- reader_ $ A.fromList x
      return $ r{readerRead = const $ fmap (A.list_ x) . readerRead_ r}
  
  
  reader_ x | A.isMaybe x = do
      r <- reader_ $ A.fromMaybe x
      return $ r{readerRead = const $ fmap (A.just_ x) . readerRead_ r}
  
  
  reader_ x | isAlgType x && length xs > 1 && all ((==) 0 . arity . snd) xs
      = Just $ Reader (map toUpper $ typeShell x) (typeName x == "Bool") 1 id $ const $ rd . map toLower
      where
          xs = [(map toLower c, compose0 x c) | c <- ctors x]
  
          rd s | null ys = Left $ "Could not read " ++ show s ++ ", expected one of: " ++ unwords (map fst xs)
               | Just (_,x) <- find ((==) s . fst) ys = Right x
               | length ys > 1 = Left $ "Ambiguous read for " ++ show s ++ ", could be any of: " ++ unwords (map fst ys)
               | otherwise = Right $ snd $ head ys
              where ys = filter (isPrefixOf s . fst) xs
  
  
  reader_ x | isAlgType x, [c] <- ctors x, x <- compose0 x c = do
      let cs = children x
      rs <- mapM reader_ cs
      let n = sum $ map readerParts rs
      return $ Reader (uncommas $ map readerHelp rs) (map readerBool rs == [True]) n id $ const $ \s ->
          let ss = commas s in
          if n == 1 then fmap (recompose x . return) $ readerRead_ (head $ filter ((==) 1 . readerParts) rs) s
          else if length ss /= n then Left "Incorrect number of commas for fields"
          else fmap (recompose x) $ sequenceEither $ zipWith readerRead_ rs $ map uncommas $ takes (map readerParts rs) ss
  
  
  reader_ _ = Nothing
  
  
  uncommas = intercalate ","
  commas = lines . map (\x -> if x == ',' then '\n' else x)
  
  
  takes [] _ = []
  takes (i:is) xs = a : takes is b
      where (a,b) = splitAt i xs
  
  sequenceEither = foldr f (Right [])
      where f (Left x) _ = Left x
            f _ (Left x) = Left x
            f (Right x) (Right xs) = Right (x:xs)
  