{-# LANGUAGE GADTs, RankNTypes, NoMonomorphismRestriction #-}

data Compoz a b where
    Id   :: (Read a, Show a) => Compoz a a
    Cons :: (Read b, Read c, Show c) => (b -> c) -> Compoz a b -> Compoz a c

data Layers = Layers Int Int

serialize   = show
deserialize = read

layer3 :: Int -> Bool
layer3 = (== 1)
layer2 :: [Int] -> Int
layer2 = length
layer1 :: Maybe Int -> [Int] 
layer1 m = case m of Just x -> [x]; Nothing -> []

chain :: Compoz (Maybe Int) Bool
chain = Cons layer3 $ Cons layer2 $ Cons layer1 $ Id

compose :: Compoz a b -> (a -> b)
compose Id          = id
compose (Cons x xs) = x . compose xs

dropC :: Int -> Compoz a b -> (forall c. Show c => Compoz a c -> d) -> d
dropC _ Id f          = f Id
dropC 0 (Cons x xs) f = f (Cons x xs)
dropC n (Cons x xs) f = dropC (n-1) xs f

takeC :: Int -> Compoz a b -> (forall c. Read c => Compoz c b -> d) -> d
takeC _ Id f          = f Id
takeC 0 (Cons x xs) f = f Id
takeC n (Cons x xs) f = takeC (n-1) xs (\ys -> f $ Cons x ys)    

lengthC :: Compoz a b -> Int
lengthC Id          = 0
lengthC (Cons x xs) = 1 + lengthC xs

runLayers :: Layers -> (String -> String)
runLayers (Layers a b) =
    dropC (n-b) chain $ \xs ->
        takeC (b-a+1) xs $ \ys ->
            serialize . compose ys . deserialize
    where
    n = lengthC chain