module DStringF(
  stringF,stringF',--stringF'',
  passwdF,passwdF',passwdF'',
  intF,intF',intF''
  ,stringInputF,intInputF,passwdInputF
  ,stringInputF',intInputF',passwdInputF'
  ) where
import FDefaults
import StringF
--import Fudget
import CompOps
--import Geometry(Rect)
--import Xtypes
--import SpEither(filterRightSP)
import InputMsg(InputMsg,mapInp)
import InputSP(inputDoneSP)--InF(..),
import EitherUtils(mapEither)
import Data.Char(isDigit)

stringInputF :: F String String
stringInputF = Customiser StringF -> F String String
stringInputF' forall a. Customiser a
standard
intInputF :: F Int Int
intInputF = Customiser StringF -> F Int Int
intInputF' forall a. Customiser a
standard
passwdInputF :: F String String
passwdInputF = Customiser StringF -> F String String
passwdInputF' forall a. Customiser a
standard
stringInputF' :: Customiser StringF -> F String String
stringInputF' Customiser StringF
pmod = forall {b}. SP (InputMsg b) b
inputDoneSP forall a b e. SP a b -> F e a -> F e b
>^^=< Customiser StringF -> F String (InputMsg String)
stringF' Customiser StringF
pmod
intInputF' :: Customiser StringF -> F Int Int
intInputF' Customiser StringF
pmod = forall {b}. SP (InputMsg b) b
inputDoneSP forall a b e. SP a b -> F e a -> F e b
>^^=< Customiser StringF -> F Int (InputMsg Int)
intF' Customiser StringF
pmod
passwdInputF' :: Customiser StringF -> F String String
passwdInputF' Customiser StringF
pmod = forall {b}. SP (InputMsg b) b
inputDoneSP forall a b e. SP a b -> F e a -> F e b
>^^=< Customiser StringF -> F String (InputMsg String)
passwdF' Customiser StringF
pmod

stringF :: F String (InputMsg String)
stringF = Customiser StringF -> F String (InputMsg String)
stringF' forall a. Customiser a
standard
stringF' :: Customiser StringF -> F String (InputMsg String)
stringF' = forall p a b. PF p a b -> F a b
noPF forall b c a. (b -> c) -> (a -> b) -> a -> c
. Customiser StringF -> PF StringF String (InputMsg String)
stringF''

passwdF :: F String (InputMsg String)
passwdF = Customiser StringF -> F String (InputMsg String)
passwdF' forall a. Customiser a
standard
passwdF' :: Customiser StringF -> F String (InputMsg String)
passwdF' = forall p a b. PF p a b -> F a b
noPF forall b c a. (b -> c) -> (a -> b) -> a -> c
. Customiser StringF -> PF StringF String (InputMsg String)
passwdF''
passwdF'' :: Customiser StringF -> PF StringF String (InputMsg String)
passwdF'' = Customiser StringF -> PF StringF String (InputMsg String)
stringF'' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String -> String) -> Customiser StringF
setShowString (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const Char
'*')))

intF :: F Int (InputMsg Int)
intF = Customiser StringF -> F Int (InputMsg Int)
intF' forall a. Customiser a
standard
intF' :: Customiser StringF -> F Int (InputMsg Int)
intF' = forall p a b. PF p a b -> F a b
noPF forall b c a. (b -> c) -> (a -> b) -> a -> c
. Customiser StringF -> PF StringF Int (InputMsg Int)
intF''

intF'' :: (Customiser StringF) -> PF StringF Int (InputMsg Int)
intF'' :: Customiser StringF -> PF StringF Int (InputMsg Int)
intF'' Customiser StringF
pmod = forall {t} {a}. (t -> a) -> InputMsg t -> InputMsg a
mapInp forall {a}. (Num a, Read a) => String -> a
read' forall a b e. (a -> b) -> F e a -> F e b
>^=<
              Customiser StringF -> PF StringF String (InputMsg String)
stringF'' (Customiser StringF
pmodforall b c a. (b -> c) -> (a -> b) -> a -> c
.Customiser StringF
pm) forall c d e. F c d -> (e -> c) -> F e d
>=^<
	      forall {t1} {a} {t2} {b}.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither forall a. Customiser a
id forall a. Show a => a -> String
show
  where
    pm :: Customiser StringF
pm = (Char -> Bool) -> Customiser StringF
setAllowedChar Char -> Bool
isDigit -- . setInitSize "1999999999"
    read' :: String -> a
read' String
"" = a
0
    read' String
s = forall a. Read a => String -> a
read String
s