-- | A class used while converting Cabal dependencies into Debian
-- dependencies.

{-# LANGUAGE FlexibleInstances, FunctionalDependencies, MultiParamTypeClasses, StandaloneDeriving, TypeSynonymInstances #-}
{-# OPTIONS_GHC -Wall -Werror #-}
module Debian.Debianize.Interspersed
    ( Interspersed(..)
    ) where

import Debug.Trace (trace)

-- | A class of Bs insterspersed with Cs.  It is used when converting
-- the cabal dependencies to debian, where the "around" type is the
-- binary package name and the "between" type is the version number.
-- 
-- Minimum implementation is a method to return the leftmost B, and
-- another to return the following (C,B) pairs.  Its unfortunate to
-- require lists in the implementation, a fold function would be
-- better (though I find implementing such folds to be a pain in the
-- you-know-what.)
-- 
-- The class provides implementations of three folds, each of which
-- exposes slightly different views of the data.
class Interspersed t around between | t -> around, t -> between where
    leftmost :: t -> around
    pairs :: t -> [(between, around)]

    foldTriples :: (around -> between -> around -> r -> r) -> r -> t -> r
    foldTriples around -> between -> around -> r -> r
f r
r0 t
x = (around, r) -> r
forall a b. (a, b) -> b
snd ((around, r) -> r) -> (around, r) -> r
forall a b. (a -> b) -> a -> b
$ ((around, r) -> (between, around) -> (around, r))
-> (around, r) -> [(between, around)] -> (around, r)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ (around
b1, r
r) (between
c, around
b2) -> (around
b1, around -> between -> around -> r -> r
f around
b1 between
c around
b2 r
r)) (t -> around
forall t around between.
Interspersed t around between =>
t -> around
leftmost t
x, r
r0) (t -> [(between, around)]
forall t around between.
Interspersed t around between =>
t -> [(between, around)]
pairs t
x)

    -- Treat the b's as the centers and the c's as the things to their
    -- left and right.  Use Maybe to make up for the missing c's at the
    -- ends.
    foldInverted :: (Maybe between -> around -> Maybe between -> r -> r) -> r -> t -> r
    foldInverted Maybe between -> around -> Maybe between -> r -> r
f r
r0 t
x =
        (\ (Maybe between
bn, around
an, r
r) -> Maybe between -> around -> Maybe between -> r -> r
f Maybe between
bn around
an Maybe between
forall a. Maybe a
Nothing r
r) ((Maybe between, around, r) -> r)
-> (Maybe between, around, r) -> r
forall a b. (a -> b) -> a -> b
$
           ((Maybe between, around, r)
 -> (between, around) -> (Maybe between, around, r))
-> (Maybe between, around, r)
-> [(between, around)]
-> (Maybe between, around, r)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Maybe between, around, r)
-> (between, around) -> (Maybe between, around, r)
forall {b}.
(Maybe between, around, r) -> (between, b) -> (Maybe between, b, r)
g (Maybe between
forall a. Maybe a
Nothing, t -> around
forall t around between.
Interspersed t around between =>
t -> around
leftmost t
x, r
r0) (t -> [(between, around)]
forall t around between.
Interspersed t around between =>
t -> [(between, around)]
pairs t
x)
        where
          g :: (Maybe between, around, r) -> (between, b) -> (Maybe between, b, r)
g (Maybe between
b1, around
a1, r
r) (between
b2, b
a2) = (between -> Maybe between
forall a. a -> Maybe a
Just between
b2, b
a2, Maybe between -> around -> Maybe between -> r -> r
f Maybe between
b1 around
a1 (between -> Maybe between
forall a. a -> Maybe a
Just between
b2) r
r)

    foldArounds :: (around -> around -> r -> r) -> r -> t -> r
    foldArounds around -> around -> r -> r
f r
r0 t
x = (around, r) -> r
forall a b. (a, b) -> b
snd ((around, r) -> r) -> (around, r) -> r
forall a b. (a -> b) -> a -> b
$ ((around, r) -> (between, around) -> (around, r))
-> (around, r) -> [(between, around)] -> (around, r)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ (around
a1, r
r) (between
_, around
a2) -> (around
a2, around -> around -> r -> r
f around
a1 around
a2 r
r)) (t -> around
forall t around between.
Interspersed t around between =>
t -> around
leftmost t
x, r
r0) (t -> [(between, around)]
forall t around between.
Interspersed t around between =>
t -> [(between, around)]
pairs t
x)

    foldBetweens :: (between -> r -> r) -> r -> t -> r
    foldBetweens between -> r -> r
f r
r0 t
x = (r -> (between, around) -> r) -> r -> [(between, around)] -> r
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ r
r (between
b, around
_) -> (between -> r -> r
f between
b r
r)) r
r0 (t -> [(between, around)]
forall t around between.
Interspersed t around between =>
t -> [(between, around)]
pairs t
x)

-- | An example
data Splits = Splits Double [(String, Double)] deriving Int -> Splits -> ShowS
[Splits] -> ShowS
Splits -> String
(Int -> Splits -> ShowS)
-> (Splits -> String) -> ([Splits] -> ShowS) -> Show Splits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Splits -> ShowS
showsPrec :: Int -> Splits -> ShowS
$cshow :: Splits -> String
show :: Splits -> String
$cshowList :: [Splits] -> ShowS
showList :: [Splits] -> ShowS
Show

instance Interspersed Splits Double String where
    leftmost :: Splits -> Double
leftmost (Splits Double
x [(String, Double)]
_) = Double
x
    pairs :: Splits -> [(String, Double)]
pairs (Splits Double
_ [(String, Double)]
x) = [(String, Double)]
x

_splits :: Splits
_splits :: Splits
_splits = Double -> [(String, Double)] -> Splits
Splits Double
1.0 [(String
"between 1 and 2", Double
2.0), (String
"between 2 and 3", Double
3.0)]

_test1 :: ()
_test1 :: ()
_test1 = (Double -> String -> Double -> () -> ()) -> () -> Splits -> ()
forall r.
(Double -> String -> Double -> r -> r) -> r -> Splits -> r
forall t around between r.
Interspersed t around between =>
(around -> between -> around -> r -> r) -> r -> t -> r
foldTriples (\ Double
l String
s Double
r () -> String -> () -> ()
forall a. String -> a -> a
trace (String
"l=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" s=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" r=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
r) ()) () Splits
_splits

_test2 :: ()
_test2 :: ()
_test2 = (Maybe String -> Double -> Maybe String -> () -> ())
-> () -> Splits -> ()
forall r.
(Maybe String -> Double -> Maybe String -> r -> r)
-> r -> Splits -> r
forall t around between r.
Interspersed t around between =>
(Maybe between -> around -> Maybe between -> r -> r) -> r -> t -> r
foldInverted (\ Maybe String
sl Double
f Maybe String
sr () -> String -> () -> ()
forall a. String -> a -> a
trace (String
"sl=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
sl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" f=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" sr=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
sr) ()) () Splits
_splits