module Engine where
import Test.QuickCheck
import Control.Monad
import Data.Maybe
import Data.List
type Change a = a -> Maybe a
data Pos
= Line {
nth :: Int
}
| Begin
| End {
lns :: Int
}
deriving Show
distance (Line n) (Line m) = m n +1
distance Begin (Line m) = m
distance (Line n) (End m) = m n
distance Begin (End m) = m
distance _ _ = 0
class Eq a => Engine a where
empty :: a
empty = listIn []
listIn :: [String] -> a
listOut :: a -> Maybe [String]
linen :: Int -> a -> Maybe [String]
line :: a -> Maybe String
line w = head `fmap` linen 1 w
jump :: Int -> Change a
ins :: [String] -> Change a
add :: [String] -> Change a
del :: Change a
deln :: Int -> Change a
end :: Change a
start :: Change a
pos :: a -> Pos
next :: Change a
prev :: Change a
prevn :: Int -> Change a
prevn 0 w = Just w
prevn n w = prev w >>= prevn (n1)
nextn :: Int -> Change a
nextn 0 w = Just w
nextn n w = next w >>= nextn (n1)
rjump :: Int -> Change a
rjump n = iterateM n (if n > 0 then next else prev) where
iterateM n f w | n > 0 = f w >>= iterateM (n 1) f
| True = Just w
tillend :: a -> [a]
fwdcycle :: a -> [a]
fromstart :: a -> [a]
bwdcycle :: a -> [a]
last :: Engine w => Change w
last t = end t >>= prev
first :: Engine w => Change w
first t = start t >>= next
newtype W w = W w deriving Show
instance (Eq w,Engine w) => Arbitrary (W w) where
arbitrary = do n <- choose (0,10)
ws <- replicateM n $ replicateM 15 $ choose ('a','z')
return $ W $ listIn ws
coarbitrary = undefined
instance Arbitrary Char where
arbitrary = choose ('a','z')
coarbitrary = undefined
prop_E1 :: (Engine w) => W w -> String -> Bool
prop_E1 (W y) = \x -> (add [x] y >>= listOut) == Just (x:fromJust (listOut y))
propInOut f xs = Just $ listIn xs >>= f >>= listOut
prop_Empty (W y) = (y == empty) ==> prev y == Nothing && next y == Nothing
prop_toEnd (W y) = (y /= empty) ==> let Just ls = length `fmap` listOut y
in collect ls $ nextn (ls +1) y == end y && nextn ls y == (end y >>= prev)
prop_toEndAndBack (W y) = (y /= empty) ==> let Just ls = length `fmap` listOut y
in collect ls $ (end y >>= start) == Just y
prop_add (W y) xs = (add xs y >>= listOut) == Just xs