module Text.Scanf.Internal where
import Data.Char (isSpace)
import Data.List (stripPrefix)
data a :+ b = a :+ b
deriving (Eq, Ord, Show)
infixr 1 :+
data Format t where
Empty :: Format ()
Constant :: String -> Format t -> Format t
Whitespace :: String -> Format t -> Format t
Readable :: (Read a, Show a) => Format t -> Format (a :+ t)
String :: Format t -> Format (String :+ t)
Char :: Format t -> Format (Char :+ t)
deriving instance Show (Format t)
emptyFmt :: Format ()
emptyFmt = Empty
fmt_ :: (Format () -> Format t) -> Format t
fmt_ f = f emptyFmt
(%) :: String -> (Format t -> Format q) -> Format t -> Format q
(%) s f = constant s . f
infixr 9 %
constant :: String -> Format t -> Format t
constant "" f = f
constant s@(c : _) f | isSpace c =
let (s0, s') = span isSpace s
in whitespace s0 (constant s' f)
constant s f =
let (s0, s') = break isSpace s
in constant' s0 (constant s' f)
constant' :: String -> Format t -> Format t
constant' s (Constant s' f) = Constant (s ++ s') f
constant' "" f = f
constant' s f = Constant s f
whitespace :: String -> Format t -> Format t
whitespace s (Whitespace s' f) = Whitespace (s ++ s') f
whitespace s f = Whitespace s f
readable :: (Read a, Show a) => Format t -> Format (a :+ t)
readable = Readable
integer :: Format t -> Format (Integer :+ t)
integer = Readable
int :: Format t -> Format (Int :+ t)
int = Readable
double :: Format t -> Format (Double :+ t)
double = Readable
string :: Format t -> Format (String :+ t)
string = String
char :: Format t -> Format (Char :+ t)
char = Char
readmap :: (a -> b) -> ReadS a -> ReadS b
readmap f = (fmap . fmap) (\(r, s) -> (f r, s))
readsFormat :: Format t -> ReadS t
readsFormat (Constant z f) s = do
Just s' <- pure (stripPrefix z s)
readsFormat f s'
readsFormat (Readable f) s = do
(a, s') <- readsPrec 0 s
readmap (a :+) (readsFormat f) s'
readsFormat (String f) s = do
let (s0, s') = break isSpace s
readmap (s0 :+) (readsFormat f) s'
readsFormat (Char f) s = do
c : s' <- pure s
readmap (c :+) (readsFormat f) s'
readsFormat (Whitespace _ f) s = do
let s' = dropWhile isSpace s
readsFormat f s'
readsFormat Empty s = pure ((), s)
scanf :: Format t -> String -> Maybe t
scanf f s = do
(r, _) : _ <- pure (readsFormat f s)
pure r
printf :: Format t -> t -> String
printf (Constant z f) t = z ++ printf f t
printf (Readable f) (a :+ t) = show a ++ printf f t
printf (String f) (s :+ t) = s ++ printf f t
printf (Char f) (c :+ t) = c : printf f t
printf (Whitespace s f) t = s ++ printf f t
printf Empty _ = ""