Skip to content

Instantly share code, notes, and snippets.

@mrexodia mrexodia/Fun.hs

Created Oct 15, 2019
Embed
What would you like to do?
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleInstances #-}
import Data.List
import Control.Monad.State
data Boool = Truue | Faalse
deriving (Show)
data Shape = Circle Float | Rectangle Float Float
deriving (Show)
data IntList = Element Int IntList | End
deriving (Show)
data IntTrie = Empty | Node IntTrie Int IntTrie
deriving (Show)
data Json = JObject [(String, Json)] | JNull | JBool Bool | JInt Integer | JString String | JList [Json]
deriving (Show)
class Jsonable a where
toJson :: a -> Json
instance Jsonable Json where
toJson = id
instance Jsonable Bool where
toJson = JBool
instance Jsonable Integer where
toJson = JInt
instance Jsonable a => Jsonable (Maybe a) where
toJson Nothing = JNull
toJson (Just v) = toJson v
instance Jsonable a => Jsonable [a] where
toJson = JList . map toJson
instance {-# OVERLAPPING #-} Jsonable [Char] where
toJson = JString
instance {-# OVERLAPPING #-} Jsonable [(String, Json)] where
toJson = JObject
(<:) :: Jsonable a => String -> a -> (String, Json)
k <: v = (k, toJson v)
jj :: Json
jj = toJson [
"knull" <: JNull,
"kbool" <: True,
"kint" <: 20,
"kstr" <: "hello",
"klist" <: [
"123",
"456",
"789"
],
"kobj" <: [
"nest1" <: [
[
"a" <: 1,
"b" <: 2,
"emptyList" <: JList []
],
[
"a" <: 3,
"b" <: 4,
"emptyObj" <: JObject []
]
],
"nest2" <: False
]]
printJson :: Json -> String
printJson JNull = "null"
printJson (JBool b) = if b then "true" else "false"
printJson (JInt n) = show n
printJson (JString s) = show s
printJson (JList vs) = "[" ++ intercalate "," (map printJson vs) ++ "]"
printJson (JObject kvs) = "{" ++ intercalate "," (map (\(k, v) -> show k ++ ":" ++ printJson v) kvs) ++ "}"
type PpState = (Int, Bool)
ppKv' :: (String, Json) -> State PpState String
ppKv' (k, v) = do
(i, _) <- get
let indent = take (i * 2) (repeat ' ')
ppJson <- ppJson' v
return $ show k ++ ": " ++ ppJson
ppJson' :: Json -> State PpState String
ppJson' JNull = return "null"
ppJson' (JBool b) = return $ if b then "true" else "false"
ppJson' (JInt n) = return $ show n
ppJson' (JString s) = return $ show s
ppJson' (JList []) = return "[]"
ppJson' (JList vs) = do
(i, root) <- get
let indent = take (i * 2) (repeat ' ')
put (i + 1, False)
ppJson <- mapM ppJson' vs
put (i, False)
return $ ((if root then indent else "") ++ "[\n " ++ indent) ++ intercalate (",\n " ++ indent) ppJson ++ ("\n" ++ indent ++ "]")
ppJson' (JObject []) = return "{}"
ppJson' (JObject kvs) = do
(i, root) <- get
let indent = take (i * 2) (repeat ' ')
put (i + 1, False)
ppJson <- mapM ppKv' kvs
put (i, False)
return $ ((if root then indent else "") ++ "{\n " ++ indent) ++ intercalate (",\n " ++ indent) ppJson ++ ("\n" ++ indent ++ "}")
ppJson :: Json -> String
ppJson j = evalState (ppJson' j) (0, True)
intLeaf :: Int -> IntTrie
intLeaf n = Node Empty n Empty
showTrie :: IntTrie -> String
showTrie Empty = ""
showTrie (Node Empty n Empty) = show n
showTrie (Node l n r) = show n ++ " " ++ showTrie l ++ " " ++ showTrie r
doubleInt :: Int -> Int
doubleInt n = n * 2
myMap :: (Int -> Int) -> [Int] -> [Int]
myMap f l = f (head l) : myMap f l
doubleList :: [Int] -> [Int]
doubleList l = map doubleInt l
tt :: IntTrie
tt = Node (Node (intLeaf 1) 2 (intLeaf 3)) 4 (intLeaf 5)
(<^>) :: Int -> IntList -> IntList
(<^>) n End = Element n End
(<^>) n (Element x l) = Element x (n <^> l)
-- (<^>) (Element x l) = (Element x l)
-- n (<^>) _ = Element n End
headList :: IntList -> Int
headList (Element n _) = n
tailList :: IntList -> IntList
tailList (Element _ l) = l
lastListN :: IntList -> Int
lastListN (Element n End) = n
lastListN (Element _ l) = lastListN l
appendList :: Int -> IntList -> IntList
appendList x End = Element x End
appendList x (Element n l) = Element n (appendList x l)
secondList :: IntList -> Int
secondList (Element n l) = headList l
sumList :: IntList -> Int
sumList End = 0
sumList (Element n l) = n + sumList l
removeLast :: IntList -> IntList
removeLast (Element n End) = End
removeLast (Element n l) = Element n (removeLast l)
popLast :: IntList -> (Int, IntList)
popLast (Element n End) = (n, End)
popLast (Element n l) = (lastN, Element n lastL) where (lastN, lastL) = popLast l
reverseList :: IntList -> IntList
reverseList End = End
reverseList (Element n End) = Element n End
-- reverseList (Element a (Element b End)) = Element b (Element a End)
-- reverseList (Element a (Element b (Element c End))) = Element c (Element b (Element a End))
reverseList ll@(Element n l) = Element lastN (reverseList lastL)
where (lastN, lastL) = popLast ll
ll = (Element 0 (Element 1 (Element 2 (Element 3 (Element 4 End)))))
maax x y = if x > y
then x
else y where
shapeDiameter :: Shape -> Float
shapeDiameter (Circle 5.0) = 10.0
shapeDiameter (Circle r) = r * 2
shapeDiameter (Rectangle w h) = (w * w + h * h) ** 0.5
showShape :: Shape -> String
showShape (Circle _) = "circle"
showShape (Rectangle _ _) = "rectangle"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.