Miscellany

module Endo
    where

data DNA = I | C | F | P
           | Skip Integer | Match [DNA] | Braced [DNA] | RNA [DNA]
           | Ref Integer Integer | RefLen Integer
           deriving (Show)

charToDNA :: Char -> DNA
charToDNA 'I' = I
charToDNA 'C' = C
charToDNA 'F' = F
charToDNA 'P' = P

nat :: [DNA] -> (Integer,[DNA])
nat (P:xs) = (0,xs)
nat (I:xs) = (2*n,  r) where (n,r) = nat xs
nat (F:xs) = (2*n,  r) where (n,r) = nat xs
nat (C:xs) = (2*n+1,r) where (n,r) = nat xs

consts :: [DNA] -> ([DNA],[DNA])
consts (C:xs)   = (I:ys,r) where (ys,r) = consts xs
consts (F:xs)   = (C:ys,r) where (ys,r) = consts xs
consts (P:xs)   = (F:ys,r) where (ys,r) = consts xs
consts (I:C:xs) = (P:ys,r) where (ys,r) = consts xs
consts xs = ([],xs)

pattern :: [DNA] -> ([DNA],[DNA])
pattern (C:xs)   = (I:ys,r) where (ys,r) = pattern xs
pattern (F:xs)   = (C:ys,r) where (ys,r) = pattern xs
pattern (P:xs)   = (F:ys,r) where (ys,r) = pattern xs
pattern (I:C:xs) = (P:ys,r) where (ys,r) = pattern xs
pattern (I:P:xs) =
    let (n,r1) = nat xs
        (ys,r) = pattern r1
    in ((Skip n):ys,r)
pattern (I:F:x:xs) =
    let (m,r1) = consts xs
        (ys,r) = pattern r1
    in ((Match m):ys,r)
pattern (I:I:P:xs) =
    let (b,r1) = pattern xs
        (ys,r) = pattern r1
    in ((Braced b):ys,r)
pattern (I:I:C:xs) = ([],xs)
pattern (I:I:F:xs) = ([],xs)
pattern (I:I:I:a:b:c:d:e:f:g:xs) =
    ((RNA [a,b,c,d,e,f,g]):ys,r) where (ys,r) = pattern xs


template :: [DNA] -> ([DNA],[DNA])
template (C:xs)   = (I:ys,r) where (ys,r) = template xs
template (F:xs)   = (C:ys,r) where (ys,r) = template xs
template (P:xs)   = (F:ys,r) where (ys,r) = template xs
template (I:C:xs) = (P:ys,r) where (ys,r) = template xs
template (I:F:xs) =
    let (l,r1) = nat xs
        (n,r2) = nat r1
        (ys,r) = template r2
    in ((Ref n l):ys,r)
template (I:P:xs) =
    let (l,r1) = nat xs
        (n,r2) = nat r1
        (ys,r) = template r2
    in ((Ref n l):ys,r)
template (I:I:C:xs) = ([],xs)
template (I:I:F:xs) = ([],xs)
template (I:I:P:xs) =
    let (n,r1) = nat xs
        (ys,r) = template r1
    in ((RefLen n):ys,r)
template (I:I:I:a:b:c:d:e:f:g:xs) =
    ((RNA [a,b,c,d,e,f,g]):ys,r) where (ys,r) = template xs


test1 = map charToDNA "ICFP"
test2 = nat $ map charToDNA "IIICCP"
test3 = pattern [I,P,I,I,C,P,C,F,P,I,C,I,P,P,I,I,C]
test4 = pattern $ map charToDNA "CIIC"
test5 = pattern $ map charToDNA "IIPIPICPIICICIIF"