sort base64/

4 files changed, 207 insertions, 13 deletions

diff --git a/base64/Makefile b/base64/Makefile
deleted file mode 100644
index 71b16ec..0000000
--- a/base64/Makefile
+++ /dev/null
@@ -1,13 +0,0 @@
-base64: base64.hs
-	#stack ghc -- -O2 base64.hs -rtsopts -prof -fprof-cafs -fprof-auto
-	stack ghc -- -O2 base64.hs   
-
-run: base64
-	./base64 10 100 +RTS -N2 
-	#cat /tmp/random.bin | ./base64 +RTS -N6 > /dev/null
-run-prof: base64prof
-	cat /tmp/random.bin | ./base64prof +RTS -N6 -p -s > /dev/null
-base64prof: base64.hs
-	stack ghc -- -threaded -rtsopts -prof -fprof-auto -fprof-cafs -O2 base64.hs -o base64prof
-genrandom:
-	dd if=/dev/urandom of=/tmp/random.bin bs=1M count=64
diff --git a/base64/base64_0.hs b/base64/base64_0.hs
new file mode 100644
index 0000000..f7673b8
--- /dev/null
+++ b/base64/base64_0.hs
@@ -0,0 +1,25 @@
+-- File: base64.hs --
+ 
+import Data.Char
+import Text.Printf
+import qualified Data.List as L
+import qualified Data.List.Split as T
+ 
+toBase64 x      = maskBase64 x . toBase64core . asciiToBin . binFill $ x
+toBase64core    = map base64toDigit . map binToDec . T.chunksOf 6
+ 
+base64toDigit x = (['A'..'Z']++['a'..'z']++['0'..'9']++['+','/']) !! x
+binToDec        = sum . map (2^) . L.findIndices (=='1') . reverse
+asciiToBin      = concat . map (\y -> printf "%08b" y) . map ord 
+binFill x       = x ++ (take (fill64length x) $ cycle "\000")
+ 
+maskBase64 o x  = take (length x - l ) x ++ (take l $ cycle "=")
+                  where l = (fill64length o)
+ 
+fill64length x | m==0      = 0
+               | otherwise = 3-m
+               where m=mod (length x) 3
+ 
+main = do
+    line <- getLine
+    putStrLn $ toBase64 line
diff --git a/base64/base64_3.hs b/base64/base64_3.hs
new file mode 100644
index 0000000..5fddf5b
--- /dev/null
+++ b/base64/base64_3.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ViewPatterns #-}
+import Data.Maybe (fromJust,isJust)
+import Data.List.Split (chunksOf)
+import Data.Tuple (swap)
+import Data.Tuple.Extra (first,second,dupe)
+import System.Environment (getArgs)
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString as B
+import qualified Data.Map.Strict as M
+import Data.Char
+import Data.Maybe
+import Data.Word
+import Data.Array
+import Data.Bits
+--import Data.ByteString.Base64.Lazy as B64
+import Data.ByteString.Base64 as B64
+import GHC.Int
+import Control.Parallel
+import Control.Parallel.Strategies
+
+main :: IO()
+main = BL.getContents >>= BL.putStr . chunkBL 3 (fromNum 6 4.toNum 8)
+
+table64 :: Array Int Word8
+table64 = array (0,63) $ zip [0..] $ map (fromIntegral.ord) $ 
+          ['A'..'Z']++['a'..'z']++['0'..'9']++['+','/']
+
+toNum :: Int->BL.ByteString->Int
+toNum s  = BL.foldl' f 0 where f a v = a `shiftL` s + fromIntegral v
+
+fromNum :: Int->Int->Int->BL.ByteString
+fromNum s l x = BL.pack $ map f (reverse [0..l-1]) 
+                where f v = table64 ! (x `shiftR` (v*s) .&. (2^s-1))
+
+chunkBL :: Int64->(BL.ByteString->BL.ByteString)->BL.ByteString->BL.ByteString
+chunkBL n f b | BL.null b  = b
+              | otherwise = let l = f . BL.take n $ b
+                                r = chunkBL n f . BL.drop n $ b
+                            in  BL.append l r    
+
+chunkB :: Int64->BL.ByteString->[BL.ByteString]
+chunkB n b | BL.null b  = []
+              | otherwise = let l = BL.take n $ b
+                                r = chunkB n . BL.drop n $ b
+                            in  l:r
+{-
+    let arr=reverse $ BL.foldr f (0,0:[]) b
+             in arr --BL.unfoldr uf (0,snd arr)
+             where uf (_,[])    = Nothing
+                   uf (3,x:xs)  = Just (table64 ! x,(0,xs))
+                   uf (c,x:xs)  = Just (table64 ! (x.&.63),(c+1,x `shiftR` 6:xs))
+                   f :: (Int,[Int]) -> Word8 -> (Int,[Int])
+                   f (_,[]) v = (0,[])
+                   f (2,x:xs) v = (0,0:(x `shiftL` 8) + fromIntegral v:xs)
+                   f (c,x:xs) v = (c+1,(x `shiftL` 8) + fromIntegral v:xs)
+
+    -- BL.unfoldr uf . (,)3 . snd . BL.foldl' f (0,0:[])
+    -- -}
+{-
+-}
+    
+
+--main = B.getContents >>= B.putStr . B64.encode
+-- Example Usage: echo "hello world" | ./base64  | ./base64 -d
+
+-- TODO
+-- cleanup/simplify
+-- unit testing (cross check with cli base64, different lengths)
+-- flag for line widht / check flags / filename on command-line 
+-- (see man base64)
+-- compare performance . named map? array?
+
+-- arg<-getArgs
+{-
+enc64 x = B.reverse $ B.unfoldr unf $ (4, (B.foldl' (\a b->a `shiftL` 8 + fromIntegral b) (0::Int) x))
+unf (c,v) = if c==0 then Nothing else let r = v .&. 63  in Just (table64 ! r,(c-1,v`shiftR` 6))
+          if length arg == 0 
+             then putStr . (++"\n") . encode64 . map fromIntegral . B.unpack $ dat
+             else B.putStr. B.pack . map fromIntegral . decode64 .  C.unpack $ dat
+-}
+
+--t1 = BL.getContents >>= BL.putStr . BL.fromChunks . map (B.map f) . BL.toChunks
+
+
+
+--enc=B.map (\x->table64 ! (x `shiftR` 4))
+
+
+
+-- -- reChunkIn :: Int -> [B.ByteString] -> [B.ByteString]
+-- -- reChunkIn !n = go
+-- --   where
+-- --     go [] = []
+-- --     go (y : ys) = case B.length y `divMod` n of
+-- --                     (_, 0) -> y : go ys
+-- --                     (d, _) -> case B.splitAt (d * n) y of
+-- --                                 (prefix, suffix) -> prefix : fixup suffix ys
+-- --     fixup acc [] = [acc]
+-- --     fixup acc (z : zs) = case B.splitAt (n - B.length acc) z of
+-- --                            (prefix, suffix) ->
+-- --                              let acc' = acc `B.append` prefix
+-- --                              in if B.length acc' == n
+-- --                                 then let zs' = if B.null suffix
+-- --                                                then          zs
+-- --                                                else suffix : zs
+-- --                                      in acc' : go zs'
+-- --                                 else -- suffix must be null
+-- --                                     fixup acc' zs
+--
+--dec64 k = M.lookup k mp where mp = M.fromList $ map swap table64
+
+{-
+encode64 :: [Int] -> [Char]
+encode64 = map (fromJust.enc64.flip mod 64)  -- concat . map (pad . first enc . second length . dupe) . chunksOf 3
+           where enc = map (fromJust . enc64) . sumC
+                 sumC = map fst . reverse . take 4 . drop 1 .iterate to64 . (,) 0 . sum  . map (uncurry (*)) . zip mult
+                 mult = map (256^) [2,1,0]
+                 to64 (r,v) = let r' = v `mod` 64 in (r',(v-r')`div`64)
+                 pad (v,l) =take 4 $ take (1+l) v ++ "==="
+
+decode64 :: [Char]->[Int]
+decode64 = map fst .  concat . map (rem . first (reverse . take 3 . drop 1 . iterate to256 . (,) 0 . dec. map (fromJust) . filter (isJust) . map dec64).second (length.filter(=='=')). dupe) . chunksOf 4 . filter (/='\n')
+           where dec = sum . map (uncurry (*)) . zip (map (64^) [3,2..]) 
+                 to256 (r,v) = let r' = v `mod` 256 in (r',(v-r')`div`256)
+                 rem (v,l) = take (3-l) v
+-}
diff --git a/base64/base64_4.hs b/base64/base64_4.hs
new file mode 100644
index 0000000..5c9a43e
--- /dev/null
+++ b/base64/base64_4.hs
@@ -0,0 +1,55 @@
+import Data.Char (ord)
+import Data.Word (Word8)
+import Data.Tuple.Extra
+import Data.Tuple (swap)
+import Data.Array (array,(!),Array)
+import Data.Bits (shiftL,shiftR,(.&.))
+import System.Environment (getArgs,getProgName,withArgs)
+import Test.Hspec (hspec,describe,it,shouldBe)
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy.Char8 as Char8
+
+main = do args<-getArgs
+          let arg=args!!0
+          prg<-getProgName
+          if length args == 0
+            then BL.getContents >>= BL.putStr . encode64
+            else if length args == 1 && arg == "-t" 
+                    then withArgs [] test 
+                    else if length args == 1 && arg == "-d" 
+                        then BL.getContents >>= BL.putStr . decode64
+                        else putStrLn $ unlines 
+                                [ "usage: "++prg++" [FLAG]"
+                                 ,"reads from stdin"
+                                 ,"default mode is encode"
+                                 ,"flags: -d decode, -t unit test"]
+
+encode64 = chunkBL 76 (flip BL.append (Char8.pack "\n")) . chunkBL 3 (from 6 4.to 8)
+decode64 = chunkBL 4 (from 8 3.to 6)
+
+tab64enc :: Array Int Word8
+tab64enc = array (0,63) $ zip [0..] $ map (fromIntegral.ord) $ 
+           ['A'..'Z']++['a'..'z']++['0'..'9']++['+','/']
+
+to s =  (\(v,l)->(v`shiftL`((3-fromIntegral l)*s),l+1)) . first (BL.foldl' f 0) . second (BL.length) . dupe 
+       where f a v = a `shiftL` s + fromIntegral v 
+
+from s l (x,m) = BL.take (fromIntegral l) . BL.pack $ (++repeat 61) $ map f (take (fromIntegral m) $ reverse [0..l-1]) 
+                 where f v = tab64enc ! (x `shiftR` (v*s) .&. (2^s-1))
+
+chunkBL n f b | BL.null b  = b
+              | otherwise = let l = f . BL.take n $ b
+                                r = chunkBL n f . BL.drop n $ b
+                            in  BL.append l r    
+
+-- |Unit Testing
+tests=[  ("any carnal pleasure.","YW55IGNhcm5hbCBwbGVhc3VyZS4=\n")
+        ,("any carnal pleasure","YW55IGNhcm5hbCBwbGVhc3VyZQ==\n")
+        ,("any carnal pleasur","YW55IGNhcm5hbCBwbGVhc3Vy\n")
+        ,("any carnal pleasu","YW55IGNhcm5hbCBwbGVhc3U=\n")
+        ,("any carnal pleas","YW55IGNhcm5hbCBwbGVhcw==\n") ]
+
+test = hspec $ do describe "Base64" $ do 
+                    it "encode" $ do  mapM_ (tst encode64) tests
+                    it "decode" $ do  mapM_ (tst decode64) (map swap tests)
+       where tst f (d,e) = (f (Char8.pack d)) `shouldBe` (Char8.pack e)